The Structure of Deception: Validation of the Lying Profile Questionnaire

Supplementary Materials

Methods

Packages & Data

Packages

library(tidyverse)
library(easystats)

> # Attaching packages (red = needs update)
> <U+2714> insight     0.9.0     <U+26A0> bayestestR  0.6.0  
> <U+2714> performance 0.4.7.1   <U+2714> parameters  0.8.0.1
> <U+2714> see         0.5.1     <U+2714> effectsize  0.3.1  
> <U+26A0> correlation 0.2.1     <U+2714> modelbased  0.3.0  
> <U+2714> report      0.1.0     
> Warnings or errors in CRAN checks for package(s) 'modelbased'.
> Restart the R-Session and update packages in red with 'easystats::easystats_update()'.

set.seed(333)

Data

labels <- read.csv("../data/labels.csv", stringsAsFactors = FALSE) %>% 
  mutate(Item = paste0(Questionnaire, "_", Item))
df_raw <- read.csv("../data/data.csv", stringsAsFactors = FALSE)

Preprocessing

df_raw <- df_raw %>% 
  mutate(Participant = paste0("S", 1:nrow(df_raw)),
         Sex = as.factor(Sex))

paste("The initial sample included", report::report_participants(df_raw))

> [1] "The initial sample included 1011 participants (Mean age = 25.56, SD = 7.89, range = [12.96, 73.51]; 55.09% females; Mean education = 3.38, SD = 2.15, range = [-7, 10])"

Measures Scoring

Utility Functions

# Reverse negative items
reverse <- function(x, mini, maxi){
  maxi - x + mini
}


# Descriptive statistics
descriptive_statistics <- function(df, begins_with){
  df %>% 
    select(dplyr::starts_with(begins_with)) %>% 
    report::report() %>% 
    report::table_long() %>% 
    select(-one_of(c("n_Obs", "Median", "MAD", "n_Missing"))) %>% 
    print()
  
  plot(df %>% 
    select(dplyr::starts_with(begins_with)) %>% 
    bayestestR::estimate_density(method = "KernSmooth") %>% 
    plot() + 
    see::theme_modern())
}

Deception and Lying Profile (LIE)

We rescaled the LIE variables, originally scored on a -10 to 10 scale, to -5 to 5, so that the coefficients are more easily interpretable (i.e., refers to a change of 10% of the scale).

df_raw[stringr::str_detect(names(df_raw), "LIE_")] <- effectsize::change_scale(df_raw[stringr::str_detect(names(df_raw), "LIE_")], from = c(-10, 10), to = c(-5, 5))

Psychopathy (TRIMP)

df_raw <- df_raw %>%
   # Transform to numeric
  mutate_at(vars(starts_with("TRIMP")), function(x) {
    ifelse(x == "TRUE", 3,
           ifelse(x == "somewhat true", 2,
                  ifelse(x == "somewhat false", 1, 0)))
    }) %>%
  # Reverse items
  mutate_at(vars("TRIMP_2", "TRIMP_4", "TRIMP_10", "TRIMP_11", "TRIMP_16", "TRIMP_21", "TRIMP_25", "TRIMP_30", "TRIMP_33", "TRIMP_35", "TRIMP_39", "TRIMP_41", "TRIMP_44", "TRIMP_47", "TRIMP_50", "TRIMP_52", "TRIMP_57"), reverse, mini = 0, maxi = 3) %>% 
  # Compute scores
      ## Boldness
  mutate(
    TRIMP_Boldness = (TRIMP_1 + TRIMP_16
                      + TRIMP_7 + TRIMP_32
                      + TRIMP_10 + TRIMP_28
                      + TRIMP_13 + TRIMP_41
                      + TRIMP_19 + TRIMP_38 + TRIMP_57
                      + TRIMP_4 + TRIMP_47 
                      + TRIMP_22 + TRIMP_35
                      + TRIMP_25 + TRIMP_50
                      + TRIMP_44 + TRIMP_54)/19,
    TRIMP_Boldness_Optimism = (TRIMP_1 + TRIMP_16)/2,
    TRIMP_Boldness_Resilience = (TRIMP_7 + TRIMP_32)/2,
    TRIMP_Boldness_Courage = (TRIMP_10 + TRIMP_28)/2,
    TRIMP_Boldness_Dominance = (TRIMP_13 + TRIMP_41)/2,
    TRIMP_Boldness_Persuasiveness = (TRIMP_19 + TRIMP_38 + TRIMP_57)/3,
    TRIMP_Boldness_Intrepidness = (TRIMP_4 + TRIMP_47)/2,
    TRIMP_Boldness_ToleranceForUncertainty = (TRIMP_22 + TRIMP_35)/2,
    TRIMP_Boldness_SelfConfidence = (TRIMP_25 + TRIMP_50)/2,
    TRIMP_Boldness_SocialAssurance = (TRIMP_44 + TRIMP_54)/2
) %>% 
      ## Meanness
  mutate(
    TRIMP_Meanness = (TRIMP_2 + TRIMP_8 + TRIMP_11 + TRIMP_20 + TRIMP_29 + TRIMP_33 + TRIMP_36 + TRIMP_48 + TRIMP_52 + TRIMP_55 
                      + TRIMP_6 + TRIMP_45
                      + TRIMP_14
                      + TRIMP_17 + TRIMP_23 + TRIMP_26 + TRIMP_42
                      + TRIMP_39
                      + TRIMP_40)/19,
    TRIMP_Meanness_Empathy = (TRIMP_2 + TRIMP_8 + TRIMP_11 + TRIMP_20 + TRIMP_29 + TRIMP_33 + TRIMP_36 + TRIMP_48 + TRIMP_52 + TRIMP_55)/10,
    TRIMP_Meanness_ExcitementSeeking = (TRIMP_6 + TRIMP_45)/2,
    TRIMP_Meanness_PhysicalAggression = TRIMP_14,
    TRIMP_Meanness_RelationalAggression = (TRIMP_17 + TRIMP_23 + TRIMP_26 + TRIMP_42)/4,
    TRIMP_Meanness_Honesty = TRIMP_39,
    TRIMP_Meanness_DestructiveAggression = TRIMP_40
) %>% 
     ## Disinhibition
  mutate(
    TRIMP_Disinhibition = (
      TRIMP_3 + TRIMP_46 + 
        TRIMP_5 + TRIMP_30 + 
        TRIMP_9 + TRIMP_15 + TRIMP_37 + TRIMP_51 +
        TRIMP_12 + TRIMP_18 + TRIMP_49 + TRIMP_56 +
        TRIMP_21 +
        TRIMP_24 + TRIMP_43 + TRIMP_53 + TRIMP_58 +
        TRIMP_27 +
        TRIMP_31 +
        TRIMP_34)/20,
    TRIMP_Disinhibition_ImpatienceUrgency = (TRIMP_3 + TRIMP_46)/2,
    TRIMP_Disinhibition_Dependability = (TRIMP_5 + TRIMP_30)/2,
    TRIMP_Disinhibition_ProblematicImpulsivity = (TRIMP_9 + TRIMP_15 + TRIMP_37 + TRIMP_51)/4,
    TRIMP_Disinhibition_Irresponsibility = (TRIMP_12 + TRIMP_18 + TRIMP_49 + TRIMP_56)/4,
    TRIMP_Disinhibition_PlanfulControl = TRIMP_21,
    TRIMP_Disinhibition_Theft = (TRIMP_24 + TRIMP_43 + TRIMP_53 + TRIMP_58)/4,
    TRIMP_Disinhibition_Alienation = TRIMP_27,
    TRIMP_Disinhibition_BoredomProneness = TRIMP_31,
    TRIMP_Disinhibition_Fraud = TRIMP_34
) %>% 
  ## General
      mutate(TRIMP_General = (TRIMP_Boldness*19 + TRIMP_Meanness*19 + TRIMP_Disinhibition*20)/58
) %>%
  # Remove individual questions
  select(-matches("TRIMP_\\d"))

Narcissism (FFNI)

df_raw <- df_raw %>%
   # Transform to numeric
  mutate_at(vars(starts_with("FFNI")), function(x) {
    ifelse(x == "Disagree strongly", 1,
           ifelse(x == "Disagree a little", 2,
                  ifelse(x == "Neither agree nor disagree", 3,
                         ifelse(x == "Agree a little", 4, 5))))
  })%>%
  # Reverse items
  mutate_at(vars("FFNI_19", "FFNI_27"), reverse, mini = 1, maxi = 5) %>% 
  # Compute scores
  mutate(
    FFNI_AcclaimSeeking = (FFNI_1 + FFNI_16 + FFNI_31 + FFNI_46),
    FFNI_Distrust = (FFNI_4 + FFNI_19 + FFNI_34 + FFNI_49),
    FFNI_Entitlement = (FFNI_5 + FFNI_20 + FFNI_35 + FFNI_50),
    FFNI_Exploitativeness = (FFNI_7 + FFNI_22 + FFNI_37 + FFNI_52),
    FFNI_Indifference = (FFNI_9 + FFNI_24 + FFNI_39 + FFNI_54),
    FFNI_LackOfEmpathy = (FFNI_10 + FFNI_25 + FFNI_40 + FFNI_55),
    FFNI_Manipulativeness = (FFNI_11 + FFNI_26 + FFNI_41 + FFNI_56),
    FFNI_NeedForAdmiration = (FFNI_12 + FFNI_27 + FFNI_42 + FFNI_57),
    FFNI_ThrillSeeking = (FFNI_15 + FFNI_30 + FFNI_45 + FFNI_60),
    FFNI_General = (FFNI_AcclaimSeeking + FFNI_Entitlement + FFNI_NeedForAdmiration + FFNI_Manipulativeness + FFNI_LackOfEmpathy + FFNI_Indifference + FFNI_ThrillSeeking + FFNI_Distrust + FFNI_Exploitativeness) / 9
) %>% 
  # Remove individual questions
  select(-matches("FFNI_\\d"))

Normal Personality (IPIP6)

df_raw <- df_raw %>%
  # Transform to numeric
  mutate_at(vars(starts_with("IPIP6")), as.numeric) %>% 
  # Reverse items
  mutate_at(vars("IPIP6_6", "IPIP6_7", "IPIP6_8", "IPIP6_9", "IPIP6_11", "IPIP6_12", "IPIP6_13", "IPIP6_15", "IPIP6_17", "IPIP6_18", "IPIP6_19", "IPIP6_20", "IPIP6_21", "IPIP6_22", "IPIP6_24"), reverse, mini = 1, maxi = 7) %>% 
  # Compute scores
  mutate(
    IPIP6_Extraversion = (IPIP6_1 + IPIP6_7 + IPIP6_19 + IPIP6_23)/4,
    IPIP6_Agreableness = (IPIP6_2 + IPIP6_8 + IPIP6_14 + IPIP6_20)/4,
    IPIP6_Conscientiousness = (IPIP6_3 + IPIP6_10 + IPIP6_11 + IPIP6_22)/4,
    IPIP6_Neuroticism = (IPIP6_4 + IPIP6_15 + IPIP6_16 + IPIP6_17)/4,
    IPIP6_Openeness = (IPIP6_5 + IPIP6_9 + IPIP6_13 + IPIP6_21)/4,
    IPIP6_HonestyHumility = (IPIP6_6 + IPIP6_12 + IPIP6_18 + IPIP6_24)/4
  ) %>% 
  # Remove individual questions
  select(-matches("IPIP6_\\d"))

Pathological Personality (PID-5)

df_raw <- df_raw %>%
  # Transform to numeric
  mutate_at(vars(starts_with("PID5")), function(x) {
    ifelse(x == "Very false or often false", 0,
           ifelse(x == "Sometimes or somewhat false", 1,
                  ifelse(x == "Sometimes or somewhat true", 2, 3)))
  }) %>% 
  # Compute scores
  mutate(
    PID5_NegativeAffect = (PID5_8 + PID5_9 + PID5_10 + PID5_11 + PID5_15)/5,
    PID5_Detachment = (PID5_4 + PID5_13 + PID5_14 + PID5_16 + PID5_18)/5,
    PID5_Antagonism = (PID5_17 + PID5_19 + PID5_20 + PID5_22 + PID5_25)/5,
    PID5_Disinhibition = (PID5_1 + PID5_2 + PID5_3 + PID5_5 + PID5_6)/5,
    PID5_Psychoticism = (PID5_7 + PID5_12 + PID5_21 + PID5_23 + PID5_24)/5,
    PID5_Pathology = (PID5_NegativeAffect + PID5_Detachment + PID5_Antagonism + PID5_Disinhibition + PID5_Psychoticism)/5
  ) %>% 
  # Remove individual questions
  select(-matches("PID5_\\d"))

Social Desirability (BIDR)

df_raw <- df_raw %>%
   # Reverse items
  mutate_at(vars("BIDR_1", "BIDR_3", "BIDR_5", "BIDR_8", "BIDR_9", "BIDR_11", "BIDR_12", "BIDR_13"), reverse, mini = 1, maxi = 7) %>% 
  # Compute scores
  mutate(
    BIDR_SelfDeceptiveEnhancement = (BIDR_1 + BIDR_2 + BIDR_3 + BIDR_4 + BIDR_5 + BIDR_6 + BIDR_7 + BIDR_8)/8,
    BIDR_ImpressionManagement = (BIDR_9 + BIDR_10 + BIDR_11 + BIDR_12 + BIDR_13 + BIDR_14 + BIDR_15 + BIDR_16)/8,
    BIDR_General = (BIDR_SelfDeceptiveEnhancement + BIDR_ImpressionManagement)/2
) %>% 
  # Remove individual questions
  select(-matches("BIDR_\\d"))

Impulsivity (UPPS)

df_raw <- df_raw %>%
   # Transform to numeric
  mutate_at(vars(starts_with("UPPS")), function(x) {
    ifelse(x == "Strongly Agree", 1,
           ifelse(x == "Somewhat agree", 2,
                  ifelse(x == "Somewhat disagree", 3, 4)))
  })%>%
  # Reverse items
  mutate_at(vars("UPPS_3", "UPPS_6", "UPPS_8", "UPPS_9", "UPPS_10", "UPPS_13", "UPPS_14", "UPPS_15", "UPPS_16", "UPPS_17", "UPPS_18", "UPPS_20"), reverse, mini = 1, maxi = 4) %>% 
  # Compute scores
  mutate(
    UPPS_NegativeUrgency = (UPPS_6 + UPPS_8 + UPPS_13 + UPPS_15)/4,
    UPPS_PositiveUrgency = (UPPS_3 + UPPS_10 + UPPS_17 + UPPS_20)/4,
    UPPS_LackOfPerseverance = (UPPS_1 + UPPS_4 + UPPS_7 + UPPS_11)/4,
    UPPS_LackOfPremeditation = (UPPS_2 + UPPS_5 + UPPS_12 + UPPS_19)/4,
    UPPS_SensationSeeking = (UPPS_9 + UPPS_14 + UPPS_16 + UPPS_18)/4,
    UPPS_General = (UPPS_NegativeUrgency + UPPS_PositiveUrgency + UPPS_LackOfPerseverance + UPPS_LackOfPremeditation + UPPS_SensationSeeking)/5
) %>% 
  # Remove individual questions
  select(-matches("UPPS_\\d"))

Emotion Regulation (DERS)

df_raw <- df_raw %>%
  # Transform to numeric
  mutate_at(vars(starts_with("DERS")), function(x) {
    ifelse(x == "Almost never (0 - 10%)", 1,
           ifelse(x == "Sometimes (11 - 35%)", 2,
                  ifelse(x == "About half the time (36 - 65%)", 3,
                         ifelse(x == "Most of the time (66 - 90%)", 4, 5))))
  }) %>%
  # Reverse items
  mutate_at(vars("DERS_1", "DERS_4", "DERS_6"), reverse, mini = 1, maxi = 5) %>% 
  # Compute scores
  mutate(
    DERS_Awareness = DERS_1 + DERS_4 + DERS_6,
    DERS_Clarity = DERS_2 + DERS_3 + DERS_5,
    DERS_Goals = DERS_8 + DERS_12 + DERS_15,
    DERS_Impulse = DERS_9 + DERS_16 + DERS_18,
    DERS_NonAcceptance = DERS_7 + DERS_13 + DERS_14,
    DERS_Strategies = DERS_10 + DERS_11 + DERS_17,
    DERS_General = (DERS_Awareness + DERS_Clarity + DERS_Goals + DERS_Impulse + DERS_NonAcceptance + DERS_Strategies) / 6
  ) %>% 
  # Remove individual questions
  select(-matches("DERS_\\d"))

Light Triad (LTS)

df_raw <- df_raw %>%
   # Transform to numeric
  mutate_at(vars(starts_with("LTS")), function(x) {
    ifelse(x == "Agree strongly", 1,
           ifelse(x == "Agree", 2,
                  ifelse(x == "Neutral", 3,
                         ifelse(x == "Disagree", 4, 5)))) 
    })%>%
  # Compute scores
  mutate(
    LTS_FaithInHumanity = (LTS_1 + LTS_4 + LTS_7 + LTS_10)/4,
    LTS_Humanism = (LTS_2 + LTS_5 + LTS_8 + LTS_11)/4,
    LTS_Kantianism = (LTS_3 + LTS_6 + LTS_9 + LTS_12)/4,
    LTS_General = (LTS_FaithInHumanity + LTS_Humanism + LTS_Kantianism)/3
) %>% 
  # Remove individual questions
  select(-matches("LTS_\\d"))

Introception (MAIA2)

df_raw <- df_raw %>%
  # Compute scores
  mutate(
   MAIA2_Noticing = (MAIA2_1 + MAIA2_2 + MAIA2_3 + MAIA2_4)/4,
   MAIA2_BodyListening = (MAIA2_5 + MAIA2_6 + MAIA2_7 + MAIA2_8 + MAIA2_9 + MAIA2_10 + MAIA2_11)/7
) %>% 
  # Remove individual questions
  select(-matches("MAIA2_\\d"))

Data Exclusion

Incomplete Data

df_incomplete <- df_raw %>% 
  filter_at(vars(matches("IPIP6|PID5|BIDR|MAIA|DERS|UPPS|FFNI|LTS|TRIMP|LIE_")), complete.cases) %>% 
  filter(Sex %in% c("Female", "Male")) %>% 
  droplevels()

paste("We excluded", nrow(df_raw) - nrow(df_incomplete), "participants with missing data.")

> [1] "We excluded 5 participants with missing data."

Time to complete

df_time <- df_incomplete %>% 
  mutate(Duration = Duration / 60) %>%  # Express in minutes
  filter(Duration < 120)

# Compute highest density intervals
ci <- bayestestR::eti(df_time$Duration, ci = c(0.8, 0.9, 0.95, 0.99))
cat(paste0("Duration Intervals:\n", paste0("  - ", insight::format_ci(ci$CI_low, ci$CI_high, ci$CI / 100), collapse = "\n")))

> Duration Intervals:
>   - 80% CI [13.09, 42.75]
>   - 90% CI [10.95, 61.94]
>   - 95% CI [9.42, 76.05]
>   - 99% CI [7.52, 96.32]

upper_limit <- ci[ci$CI == 90, "CI_high"]
lower_limit <- ci[ci$CI == 90, "CI_low"]

# Visualisation
ci %>% 
  plot(show_zero = FALSE, show_title = FALSE) +
  geom_vline(xintercept = c(upper_limit, lower_limit), color="red", linetype="dotted") +
  theme_modern() +
  scale_fill_viridis_d() +
  ylab("Distribution") +
  xlab("Time to complete (in minutes)") 

df_time <- df_time %>% 
  filter(Duration <= upper_limit,
         Duration >= lower_limit)

paste("We excluded", nrow(df_incomplete) - nrow(df_time), "participants with a completion time outside the 90% percentile (>", insight::format_value(lower_limit), "min and <", insight::format_value(upper_limit), "min).")

> [1] "We excluded 141 participants with a completion time outside the 90% percentile (> 10.95 min and < 61.94 min)."

Multivariate outliers

outliers <- df_time %>%
  select(matches("LIE_|BIDR|IPIP6|PID5|TRIMP|FFNI|UPPS|DERS|LTS|MAIA"), -matches("_Profile|_General|_Pathology|Disinhibition_|Meanness_|Boldness_")) %>%
  select(matches("LIE_")) %>%
  effectsize::standardize() %>%
  performance::check_outliers(method = "all")

n_methods <- length(attributes(outliers)$method)

# Visualise
as.data.frame(outliers) %>%
  mutate(Outlier = as.factor(paste0(round(Outlier*n_methods), "/", n_methods))) %>%
  ggplot(aes(x = Outlier, fill = Outlier)) +
  geom_bar() +
  geom_vline(aes(xintercept = 6.5), color = "red", linetype = "dotted") +
  theme_modern() +
  see::scale_fill_metro_d(guide = FALSE) +
  xlab("Number of methods detecting the same outliers") +
  ylab("Number of participants")

df <- df_time[-which(as.numeric(outliers) >= 6/ n_methods), ]

paste("Based on a composite outlier score (see the 'check_outliers' function in the 'performance' R package; Lüdecke et al., 2019) obtained via the joint application of multiple outliers detection algorithms (Z-scores, Iglewicz, 1993; Interquartile range (IQR); Mahalanobis distance, Cabana, 2019; Robust Mahalanobis distance, Gnanadesikan & Kettenring, 1972; Minimum Covariance Determinant, Leys et al., 2018; Invariant Coordinate Selection, Archimbaud et al., 2018; Isolation Forest, Liu et al. 2008; and Local Outlier Factor, Breunig et al., 2000), we excluded", nrow(df_time) - nrow(df), "participants that were classified as outliers by at least 8/10 of the methods used.")

> [1] "Based on a composite outlier score (see the 'check_outliers' function in the 'performance' R package; Lüdecke et al., 2019) obtained via the joint application of multiple outliers detection algorithms (Z-scores, Iglewicz, 1993; Interquartile range (IQR); Mahalanobis distance, Cabana, 2019; Robust Mahalanobis distance, Gnanadesikan & Kettenring, 1972; Minimum Covariance Determinant, Leys et al., 2018; Invariant Coordinate Selection, Archimbaud et al., 2018; Isolation Forest, Liu et al. 2008; and Local Outlier Factor, Breunig et al., 2000), we excluded 149 participants that were classified as outliers by at least 8/10 of the methods used."

Final Sample

paste("The final sample included", report_participants(df))

> [1] "The final sample included 716 participants (Mean age = 25.02, SD = 7.07, range = [16.55, 73.51]; 55.87% females; Mean education = 3.54, SD = 1.95, range = [-7, 10])"

df <- df %>% 
  mutate(System_Screen = sqrt(System_Screen),
         Education_Student = as.factor(ifelse(Education_Student == "", NA, Education_Student)),
         Religion_Type = ifelse(Religion_Type == "", NA, Religion_Type), 
         Singapore_Duration = ifelse(Singapore_Duration > Age, NA, Singapore_Duration),
         Singapore_Duration = Singapore_Duration / Age)

df %>% 
  select(System_Device, System_Screen, Duration, Education_Student, Education_Type, Ethnicity, starts_with("Religion"), Income, Singapore_Duration) %>% 
  report(levels_percentage = TRUE, missing_percentage = TRUE, n_entries = 10)

> The data contains 716 observations of the following variables:
>   - System_Device: 3 entries: Phone, 74.02%; Computer, 25.14%; Tablet, 0.84%(0.00% missing)
>   - System_Screen: Mean = 694.44, SD = 267.84, Median = 552.00, MAD = 76.91, range: [426.33, 2225.67], Skewness = 1.50, Kurtosis = 1.63, 0% missing
>   - Duration: Mean = 23.75, SD = 9.53, Median = 21.21, MAD = 7.08, range: [10.97, 61.70], Skewness = 1.42, Kurtosis = 2.06, 0% missing
>   - Education_Student: 2 levels: No (n = 212, 29.61%); Yes (n = 503, 70.25%) and missing (n = 1, 0.14%)
>   - Education_Type: 17 entries: Business and Accountancy, 21.51%; Engineering, 19.13%; Social Sciences (Psychology, Sociology, etc.), 16.20%; Sciences, 10.89%; Others, 7.26%; Computing, 5.87%; Humanities (Languages, History, etc.), 5.17%; Communication Studies, 3.77%; Medicine, 2.93%; Art and Design, 1.96% and 7 others(0.00% missing)
>   - Ethnicity: 21 entries: Chinese, 87.85%; Malay, 4.05%; Indian, 3.49%; , 1.82%; Vietnamese, 0.42%; Eurasian, 0.28%; African, 0.14%; Arabic, 0.14%; Boyanese , 0.14%; Caucasian, 0.14% and 11 others(0.00% missing)
>   - Religion_Type: 6 entries: Buddhism, 32.12%; No religion, 26.12%; Christianity, 25.00%; Taoism, 6.28%; Islam, 4.75%; Hinduism, 2.51%(3.21% missing)
>   - Religion_Religiosity: Mean = 4.14, SD = 2.97, Median = , MAD = 4.45, range: [0, 10], Skewness = 0.09, Kurtosis = -1.26, 2.93% missing
>   - Religion_Engagement: Mean = 3.73, SD = 3.07, Median = , MAD = 4.45, range: [0, 10], Skewness = 0.33, Kurtosis = -1.15, 3.63% missing
>   - Income: Mean = 2815.77, SD = 4352.05, Median = , MAD = 1482.60, range: [0, 60000], Skewness = 8.67, Kurtosis = 101.04, 13.83% missing
>   - Singapore_Duration: Mean = 0.89, SD = 0.24, Median = , MAD = 0.02, range: [0, 1.00], Skewness = -2.55, Kurtosis = 5.09, 24.44% missing

df <- df %>% 
  mutate(Education_Type = ifelse(!Education_Type %in% c("Business and Accountancy",
                                                        "Engineering",
                                                        "Social Sciences (Psychology, Sociology...)",
                                                        "Sciences",
                                                        "Computing",
                                                        "Humanities (Languages, History...)"), "Other", Education_Type),
         Ethnicity = ifelse(!Ethnicity %in% c("Chinese", "Malay", "Indian"), "Other", Ethnicity))

Education and Income

report_participants(df, group = c("Sex", "Education_Student"))

> [1] "For the 'Sex - Female and Education_Student - No' group: 125 participants (Mean age = 30.43, SD = 10.99, range = [21.73, 73.51]; 100.00% females; Mean education = 2.84, SD = 2.74, range = [-7, 6]), for the 'Sex - Male and Education_Student - No' group: 87 participants (Mean age = 30.18, SD = 10.85, range = [19.73, 62.66]; 0.00% females; Mean education = 2.25, SD = 2.66, range = [-6, 10]), for the 'Sex - Female and Education_Student - Yes' group: 275 participants (Mean age = 22.37, SD = 1.95, range = [16.55, 40.70]; 100.00% females; Mean education = 3.96, SD = 1.46, range = [-2, 10]) and for the 'Sex - Male and Education_Student - Yes' group: 228 participants (Mean age = 23.30, SD = 2.10, range = [19.02, 39.79]; 0.00% females; Mean education = 3.90, SD = 1.18, range = [-2, 10])"

as.data.frame(table(df$Education_Type)) %>%
  ggplot(aes(x="", y =Freq, fill = reorder(Var1, -Freq))) +
  geom_bar(width = 1, stat = "identity") +
  labs(fill = "Course") +
  coord_polar("y", start = 0, direction = -1) +
  scale_fill_brewer(palette="Blues") +
  theme_void() +
  theme(legend.text = element_text(size = 20)) +
  theme(legend.title = element_text(face = "bold", size = 20))

df %>% 
  filter(!is.na(Education_Student)) %>% 
  filter(Income < 18000) %>% 
  ggplot(aes(x = Income, colour = Education_Type)) +
  geom_density(size = 1) +
  facet_grid(~Education_Student, labeller = "label_both") +
  theme_modern()

df %>% 
  filter(!is.na(Education_Student)) %>% 
  filter(Income < 18000) %>% 
  ggplot(aes(x = Age, y = Income, colour = Education_Type, fill = Education_Type)) +
  geom_point2() +
  geom_smooth(method = "lm", alpha = 0.1) + 
  theme_modern()

Culture

as.data.frame(table(df$Ethnicity)) %>%
  ggplot(aes(x="", y = Freq, fill = reorder(Var1, -Freq))) +
  labs(fill = "Ethnicity") +
  geom_bar(width = 1, stat = "identity") +
  coord_polar("y", start = 0) +
  scale_fill_brewer(palette="Oranges") +
  theme_void() +
  theme(legend.text = element_text(size = 20)) +
  theme(legend.title = element_text(face = "bold", size = 20))

df %>% 
  filter(!is.na(Singapore_Duration)) %>% 
  ggplot(aes(x = Singapore_Duration, colour = Ethnicity)) +
  geom_density(size = 1) +
  theme_modern() +
  scale_x_continuous(labels = scales::percent)

Religion

as.data.frame(table(df$Religion_Type)) %>%
  ggplot(aes(x="", y = Freq, fill = reorder(Var1, -Freq))) +
  geom_bar(width = 1, stat = "identity") +
  labs(fill = "Religion") +
  coord_polar("y", start = 0) +
  scale_fill_brewer(palette="Purples") +
  theme_void() +
  theme(legend.text = element_text(size = 20)) +
  theme(legend.title = element_text(face = "bold", size = 20))

df %>% 
  filter(!is.na(Religion_Engagement)) %>% 
  filter(!is.na(Religion_Type)) %>% 
  ggplot(aes(x = Religion_Engagement, colour = Religion_Type)) +
  geom_density(size = 1) +
  theme_modern()

df %>% 
  filter(!is.na(Religion_Religiosity)) %>% 
  filter(!is.na(Religion_Type)) %>% 
  ggplot(aes(x = Religion_Religiosity, colour = Religion_Type)) +
  geom_density(size = 1) +
  theme_modern()

df %>% 
  filter(!is.na(Religion_Engagement)) %>% 
  filter(!is.na(Religion_Religiosity)) %>% 
  filter(!is.na(Religion_Type)) %>% 
  ggplot(aes(x = Religion_Religiosity, y = Religion_Engagement, colour = Religion_Type, fill = Religion_Type)) +
  geom_jitter() +
  geom_smooth(method = "lm", alpha = 0.2) +
  ggtitle(paste("r =", insight::format_value(cor.test(df$Religion_Engagement, df$Religion_Religiosity)$estimate))) +
  theme_modern()

df <- df %>% 
  mutate(Religion_Faith = (Religion_Engagement + Religion_Religiosity) / 2)

Results

Descriptive Statistics

Deception and Lying Profile (LIE)

descriptive_statistics(df, "LIE_")

> Variable |  Mean |   SD | Min |  Max | Skewness | Kurtosis
> ----------------------------------------------------------
> LIE_1    | -1.70 | 2.39 |  -5 | 5.00 |     0.47 |    -0.56
> LIE_2    | -1.32 | 2.52 |  -5 | 5.00 |     0.34 |    -0.79
> LIE_3    | -2.49 | 2.56 |  -5 | 5.00 |     1.03 |     0.29
> LIE_4    | -1.56 | 2.41 |  -5 | 5.00 |     0.37 |    -0.69
> LIE_5    | -1.80 | 2.26 |  -5 | 5.00 |     0.49 |    -0.47
> LIE_6    | -0.98 | 2.55 |  -5 | 5.00 |     0.14 |    -0.96
> LIE_7    | -0.84 | 2.62 |  -5 | 5.00 |     0.16 |    -0.94
> LIE_8    | -1.41 | 2.22 |  -5 | 4.25 |     0.31 |    -0.62
> LIE_9    | -0.13 | 2.71 |  -5 | 5.00 |    -0.15 |    -0.94
> LIE_10   |  0.20 | 2.66 |  -5 | 5.00 |    -0.30 |    -0.78
> LIE_11   | -0.29 | 2.59 |  -5 | 5.00 |    -0.07 |    -0.85
> LIE_12   |  0.79 | 2.63 |  -5 | 5.00 |    -0.56 |    -0.48
> LIE_13   | -0.49 | 2.51 |  -5 | 5.00 |     0.27 |    -0.63
> LIE_14   |  0.46 | 2.40 |  -5 | 5.00 |    -0.41 |    -0.51
> LIE_15   |  0.21 | 2.56 |  -5 | 5.00 |    -0.21 |    -0.75
> LIE_16   | -0.99 | 2.31 |  -5 | 5.00 |     0.38 |    -0.31
> LIE_17   |  0.40 | 2.65 |  -5 | 5.00 |    -0.03 |    -0.89
> LIE_18   |  0.04 | 2.64 |  -5 | 5.00 |    -0.25 |    -0.84
> LIE_19   |  0.94 | 2.60 |  -5 | 5.00 |    -0.29 |    -0.85
> LIE_20   | -0.18 | 2.56 |  -5 | 5.00 |    -0.09 |    -0.83
> LIE_21   | -1.03 | 2.69 |  -5 | 5.00 |     0.35 |    -0.79
> LIE_22   | -2.20 | 2.32 |  -5 | 5.00 |     0.62 |    -0.50
> LIE_23   | -1.83 | 2.28 |  -5 | 5.00 |     0.52 |    -0.48
> LIE_24   |  1.27 | 2.23 |  -5 | 5.00 |    -0.32 |    -0.45
> LIE_25   |  1.74 | 2.33 |  -5 | 5.00 |    -0.58 |    -0.19
> LIE_26   | -2.59 | 2.14 |  -5 | 5.00 |     0.80 |    -0.05
> LIE_27   |  1.13 | 2.53 |  -5 | 5.00 |    -0.38 |    -0.66
> LIE_28   | -0.21 | 2.53 |  -5 | 5.00 |    -0.09 |    -0.68
> LIE_29   | -0.91 | 2.69 |  -5 | 5.00 |     0.28 |    -0.83
> LIE_30   |  0.48 | 2.65 |  -5 | 5.00 |    -0.38 |    -0.74
> LIE_31   | -0.42 | 2.57 |  -5 | 5.00 |    -0.02 |    -0.89
> LIE_32   |  0.55 | 2.63 |  -5 | 5.00 |    -0.36 |    -0.70
> LIE_33   |  1.90 | 2.09 |  -5 | 5.00 |    -1.01 |     1.45
> LIE_34   |  2.53 | 1.99 |  -5 | 5.00 |    -0.72 |     0.40
> LIE_35   |  1.71 | 2.22 |  -5 | 5.00 |    -0.52 |    -0.20
> LIE_36   |  0.90 | 2.37 |  -5 | 5.00 |    -0.20 |    -0.66
> LIE_37   |  0.55 | 2.68 |  -5 | 5.00 |     0.05 |    -0.96
> LIE_38   |  1.81 | 2.46 |  -5 | 5.00 |    -0.50 |    -0.66
> LIE_39   |  1.74 | 2.39 |  -5 | 5.00 |    -0.87 |     0.39
> LIE_40   |  1.78 | 2.34 |  -5 | 5.00 |    -0.68 |     0.04
> LIE_41   |  0.88 | 2.63 |  -5 | 5.00 |    -0.16 |    -0.79
> LIE_42   |  1.88 | 2.16 |  -5 | 5.00 |    -0.77 |     0.82
> LIE_43   |  1.85 | 2.19 |  -5 | 5.00 |    -0.96 |     1.12
> LIE_44   |  1.99 | 2.38 |  -5 | 5.00 |    -0.65 |    -0.13

Psychopathy (TRIMP)

df %>% 
  select(TRIMP_General, starts_with("TRIMP_Boldness"), starts_with("TRIMP_Meanness"), starts_with("TRIMP_Disinhibition")) %>% 
  report() %>% 
  table_long() %>% 
  select(-one_of(c("n_Obs", "Median", "MAD", "n_Missing"))) %>% 
  print()

> Variable                                   | Mean |   SD |  Min |  Max | Skewness | Kurtosis
> --------------------------------------------------------------------------------------------
> TRIMP_General                              | 1.08 | 0.28 | 0.34 | 2.09 |     0.33 |    -0.02
> TRIMP_Boldness                             | 1.42 | 0.39 | 0.11 | 2.47 |    -0.19 |     0.22
> TRIMP_Boldness_Optimism                    | 1.71 | 0.57 | 0.00 | 3.00 |    -0.36 |     0.26
> TRIMP_Boldness_Resilience                  | 1.52 | 0.65 | 0.00 | 3.00 |    -0.12 |    -0.28
> TRIMP_Boldness_Courage                     | 1.34 | 0.68 | 0.00 | 3.00 |     0.07 |    -0.15
> TRIMP_Boldness_Dominance                   | 1.39 | 0.72 | 0.00 | 3.00 |    -0.02 |    -0.37
> TRIMP_Boldness_Persuasiveness              | 1.53 | 0.62 | 0.00 | 3.00 |    -0.18 |    -0.19
> TRIMP_Boldness_Intrepidness                | 1.06 | 0.74 | 0.00 | 3.00 |     0.34 |    -0.59
> TRIMP_Boldness_ToleranceForUncertainty     | 1.31 | 0.61 | 0.00 | 3.00 |     0.06 |     0.20
> TRIMP_Boldness_SelfConfidence              | 1.56 | 0.67 | 0.00 | 3.00 |     0.09 |    -0.32
> TRIMP_Boldness_SocialAssurance             | 1.30 | 0.67 | 0.00 | 3.00 |     0.07 |    -0.16
> TRIMP_Meanness                             | 0.88 | 0.41 | 0.00 | 2.63 |     0.37 |     0.04
> TRIMP_Meanness_Empathy                     | 0.80 | 0.46 | 0.00 | 2.40 |     0.32 |    -0.41
> TRIMP_Meanness_ExcitementSeeking           | 1.29 | 0.80 | 0.00 | 3.00 |     0.02 |    -0.69
> TRIMP_Meanness_PhysicalAggression          | 0.87 | 0.92 | 0.00 | 3.00 |     0.64 |    -0.73
> TRIMP_Meanness_RelationalAggression        | 1.03 | 0.63 | 0.00 | 3.00 |     0.28 |    -0.49
> TRIMP_Meanness_Honesty                     | 0.82 | 0.71 | 0.00 | 3.00 |     0.65 |     0.38
> TRIMP_Meanness_DestructiveAggression       | 0.35 | 0.64 | 0.00 | 3.00 |     1.79 |     2.44
> TRIMP_Disinhibition                        | 0.94 | 0.41 | 0.05 | 2.55 |     0.55 |     0.19
> TRIMP_Disinhibition_ImpatienceUrgency      | 1.75 | 0.59 | 0.00 | 3.00 |    -0.27 |     0.10
> TRIMP_Disinhibition_Dependability          | 0.93 | 0.67 | 0.00 | 3.00 |     0.35 |    -0.26
> TRIMP_Disinhibition_ProblematicImpulsivity | 1.12 | 0.64 | 0.00 | 3.00 |     0.15 |    -0.48
> TRIMP_Disinhibition_Irresponsibility       | 0.65 | 0.61 | 0.00 | 2.75 |     0.84 |     0.00
> TRIMP_Disinhibition_PlanfulControl         | 1.10 | 0.66 | 0.00 | 3.00 |     0.51 |     0.81
> TRIMP_Disinhibition_Theft                  | 0.39 | 0.52 | 0.00 | 2.50 |     1.45 |     1.55
> TRIMP_Disinhibition_Alienation             | 1.45 | 0.86 | 0.00 | 3.00 |     0.01 |    -0.66
> TRIMP_Disinhibition_BoredomProneness       | 1.71 | 0.81 | 0.00 | 3.00 |    -0.23 |    -0.40
> TRIMP_Disinhibition_Fraud                  | 0.41 | 0.70 | 0.00 | 3.00 |     1.69 |     2.12

plots(
  df %>% 
    select(starts_with("TRIMP_Boldness")) %>% 
    bayestestR::estimate_density(method = "KernSmooth") %>% 
    plot() + 
    theme_modern(),
  df %>% 
    select(starts_with("TRIMP_Meanness")) %>% 
    bayestestR::estimate_density(method = "KernSmooth") %>% 
    plot() + 
    theme_modern(),
  df %>% 
    select(starts_with("TRIMP_Disinhibition")) %>% 
    bayestestR::estimate_density(method = "KernSmooth") %>% 
    plot() + 
    theme_modern()
    )

Narcissism (FFNI)

descriptive_statistics(df, "FFNI")

> Variable               |  Mean |   SD |  Min |   Max | Skewness | Kurtosis
> --------------------------------------------------------------------------
> FFNI_AcclaimSeeking    | 14.14 | 3.44 | 4.00 | 20.00 |    -0.68 |     0.43
> FFNI_Distrust          | 12.34 | 2.89 | 4.00 | 20.00 |     0.04 |    -0.09
> FFNI_Entitlement       |  9.90 | 3.69 | 4.00 | 20.00 |     0.19 |    -0.73
> FFNI_Exploitativeness  |  9.04 | 3.76 | 4.00 | 20.00 |     0.38 |    -0.73
> FFNI_Indifference      | 10.89 | 3.80 | 4.00 | 20.00 |     0.24 |    -0.59
> FFNI_LackOfEmpathy     |  9.12 | 3.18 | 4.00 | 20.00 |     0.51 |    -0.15
> FFNI_Manipulativeness  | 10.32 | 3.74 | 4.00 | 20.00 |     0.19 |    -0.73
> FFNI_NeedForAdmiration | 12.97 | 2.94 | 4.00 | 20.00 |    -0.39 |     0.25
> FFNI_ThrillSeeking     | 10.54 | 3.79 | 4.00 | 20.00 |     0.10 |    -0.80
> FFNI_General           | 11.03 | 1.97 | 5.89 | 19.44 |     0.28 |     0.58

Normal Personality (IPIP6)

descriptive_statistics(df, "IPIP6")

> Variable                | Mean |   SD |  Min |  Max | Skewness | Kurtosis
> -------------------------------------------------------------------------
> IPIP6_Extraversion      | 3.58 | 1.20 | 1.00 | 6.75 |     0.15 |    -0.57
> IPIP6_Agreableness      | 5.01 | 0.91 | 1.25 | 7.00 |    -0.38 |     0.46
> IPIP6_Conscientiousness | 4.43 | 1.08 | 1.00 | 7.00 |    -0.27 |    -0.03
> IPIP6_Neuroticism       | 3.94 | 1.13 | 1.00 | 7.00 |     0.02 |    -0.18
> IPIP6_Openeness         | 4.56 | 1.08 | 1.25 | 7.00 |    -0.12 |    -0.33
> IPIP6_HonestyHumility   | 4.39 | 1.23 | 1.00 | 7.00 |    -0.06 |    -0.55

Pathological Personality (PID-5)

descriptive_statistics(df, "PID5")

> Variable            | Mean |   SD | Min | Max | Skewness | Kurtosis
> -------------------------------------------------------------------
> PID5_NegativeAffect | 1.42 | 0.63 |   0 |   3 |    -0.10 |    -0.35
> PID5_Detachment     | 1.09 | 0.56 |   0 |   3 |     0.21 |    -0.02
> PID5_Antagonism     | 0.89 | 0.54 |   0 |   3 |     0.42 |     0.12
> PID5_Disinhibition  | 0.99 | 0.64 |   0 |   3 |     0.17 |    -0.69
> PID5_Psychoticism   | 1.24 | 0.61 |   0 |   3 |    -0.07 |    -0.29
> PID5_Pathology      | 1.13 | 0.45 |   0 |   3 |     0.12 |     0.37

Social Desirability (BIDR)

descriptive_statistics(df, "BIDR")

> Variable                      | Mean |   SD |  Min |  Max | Skewness | Kurtosis
> -------------------------------------------------------------------------------
> BIDR_SelfDeceptiveEnhancement | 3.86 | 0.79 | 1.50 | 6.12 |    -0.03 |     0.28
> BIDR_ImpressionManagement     | 3.78 | 0.82 | 1.00 | 6.62 |     0.14 |     0.73
> BIDR_General                  | 3.82 | 0.65 | 1.44 | 6.38 |     0.13 |     0.95

Impulsivity (UPPS)

descriptive_statistics(df, "UPPS")

> Variable                 | Mean |   SD |  Min |  Max | Skewness | Kurtosis
> --------------------------------------------------------------------------
> UPPS_NegativeUrgency     | 2.40 | 0.64 | 1.00 | 4.00 |    -0.11 |    -0.35
> UPPS_PositiveUrgency     | 2.13 | 0.62 | 1.00 | 4.00 |     0.02 |    -0.51
> UPPS_LackOfPerseverance  | 1.87 | 0.46 | 1.00 | 4.00 |     0.18 |     0.48
> UPPS_LackOfPremeditation | 1.87 | 0.46 | 1.00 | 3.75 |     0.11 |     0.67
> UPPS_SensationSeeking    | 2.68 | 0.66 | 1.00 | 4.00 |    -0.28 |    -0.25
> UPPS_General             | 2.19 | 0.35 | 1.10 | 3.55 |    -0.25 |     0.01

Emotion Regulation (DERS)

descriptive_statistics(df, "DERS")

> Variable           | Mean |   SD |  Min |   Max | Skewness | Kurtosis
> ---------------------------------------------------------------------
> DERS_Awareness     | 7.00 | 2.06 | 3.00 | 13.00 |     0.32 |    -0.21
> DERS_Clarity       | 7.46 | 2.53 | 3.00 | 15.00 |     0.50 |    -0.05
> DERS_Goals         | 9.41 | 3.18 | 3.00 | 15.00 |    -0.01 |    -0.99
> DERS_Impulse       | 6.78 | 3.02 | 3.00 | 15.00 |     0.66 |    -0.33
> DERS_NonAcceptance | 7.35 | 3.10 | 3.00 | 15.00 |     0.55 |    -0.48
> DERS_Strategies    | 6.98 | 3.04 | 3.00 | 15.00 |     0.56 |    -0.57
> DERS_General       | 7.50 | 1.95 | 3.50 | 13.33 |     0.28 |    -0.52

Light Triad (LTS)

descriptive_statistics(df, "LTS")

> Variable            | Mean |   SD | Min |  Max | Skewness | Kurtosis
> --------------------------------------------------------------------
> LTS_FaithInHumanity | 2.41 | 0.66 |   1 | 4.75 |     0.64 |     0.67
> LTS_Humanism        | 2.04 | 0.50 |   1 | 4.00 |     0.23 |     0.38
> LTS_Kantianism      | 2.08 | 0.56 |   1 | 4.00 |     0.31 |     0.14
> LTS_General         | 2.18 | 0.45 |   1 | 4.00 |     0.18 |     0.33

Interoception (MAIA2)

descriptive_statistics(df, "MAIA2")

> Variable            | Mean |   SD | Min | Max | Skewness | Kurtosis
> -------------------------------------------------------------------
> MAIA2_Noticing      | 3.12 | 0.89 |   0 |   5 |    -0.46 |     0.35
> MAIA2_BodyListening | 2.77 | 0.93 |   0 |   5 |    -0.39 |     0.08

Factor Structure

Splitting the data 50-50 for EFA-CFA

lie <- select(df, starts_with("LIE_"))
labels_lie <- labels[labels$Questionnaire == "LIE", ]

# Two sets of data 60-40
partitions <- parameters::data_partition(lie, training_proportion = 0.6)
lie_EFA <- partitions$training
lie_CFA <- partitions$test


# Compare stats across groups
group_indices = c(rep(2, round(nrow(lie)/2)), rep(1, nrow(lie) - round(nrow(lie)/2)))
lie_grouped <- cbind(lie, group_indices) 

psych::statsBy(lie_grouped, group = "group_indices")

> Statistics within and between groups  
> Call: psych::statsBy(data = lie_grouped, group = "group_indices")
> Intraclass Correlation 1 (Percentage of variance due to groups) 
>         LIE_1         LIE_2         LIE_3         LIE_4         LIE_5 
>          0.00          0.00          0.00          0.00          0.03 
>         LIE_6         LIE_7         LIE_8         LIE_9        LIE_10 
>          0.01          0.00          0.00          0.00          0.00 
>        LIE_11        LIE_12        LIE_13        LIE_14        LIE_15 
>          0.00          0.00          0.00          0.00          0.00 
>        LIE_16        LIE_17        LIE_18        LIE_19        LIE_20 
>          0.00          0.00          0.00          0.00          0.00 
>        LIE_21        LIE_22        LIE_23        LIE_24        LIE_25 
>          0.00          0.00          0.00          0.00          0.00 
>        LIE_26        LIE_27        LIE_28        LIE_29        LIE_30 
>          0.01          0.00          0.00          0.01          0.00 
>        LIE_31        LIE_32        LIE_33        LIE_34        LIE_35 
>          0.00          0.00          0.00          0.01          0.00 
>        LIE_36        LIE_37        LIE_38        LIE_39        LIE_40 
>          0.02          0.01          0.00          0.00          0.00 
>        LIE_41        LIE_42        LIE_43        LIE_44 group_indices 
>          0.01          0.00          0.00          0.01          1.00 
> Intraclass Correlation 2 (Reliability of group differences) 
>         LIE_1         LIE_2         LIE_3         LIE_4         LIE_5 
>          0.45         -1.14        -17.63          0.36          0.91 
>         LIE_6         LIE_7         LIE_8         LIE_9        LIE_10 
>          0.75          0.41          0.31         -1.44         -3.98 
>        LIE_11        LIE_12        LIE_13        LIE_14        LIE_15 
>         -2.47        -12.61        -27.85        -54.67         -0.30 
>        LIE_16        LIE_17        LIE_18        LIE_19        LIE_20 
>          0.36         -4.47         -0.22         -0.13          0.41 
>        LIE_21        LIE_22        LIE_23        LIE_24        LIE_25 
>        -43.53         -3.90          0.55        -17.65          0.54 
>        LIE_26        LIE_27        LIE_28        LIE_29        LIE_30 
>          0.83         -0.72          0.52          0.81          0.26 
>        LIE_31        LIE_32        LIE_33        LIE_34        LIE_35 
>        -13.59        -16.87         -0.35          0.77          0.33 
>        LIE_36        LIE_37        LIE_38        LIE_39        LIE_40 
>          0.87          0.84          0.61          0.48         -4.07 
>        LIE_41        LIE_42        LIE_43        LIE_44 group_indices 
>          0.84         -3.38        -23.52          0.69          1.00 
> eta^2 between groups  
>  LIE_1.bg  LIE_2.bg  LIE_3.bg  LIE_4.bg  LIE_5.bg  LIE_6.bg  LIE_7.bg  LIE_8.bg 
>      0.00      0.00      0.00      0.00      0.01      0.01      0.00      0.00 
>  LIE_9.bg LIE_10.bg LIE_11.bg LIE_12.bg LIE_13.bg LIE_14.bg LIE_15.bg LIE_16.bg 
>      0.00      0.00      0.00      0.00      0.00      0.00      0.00      0.00 
> LIE_17.bg LIE_18.bg LIE_19.bg LIE_20.bg LIE_21.bg LIE_22.bg LIE_23.bg LIE_24.bg 
>      0.00      0.00      0.00      0.00      0.00      0.00      0.00      0.00 
> LIE_25.bg LIE_26.bg LIE_27.bg LIE_28.bg LIE_29.bg LIE_30.bg LIE_31.bg LIE_32.bg 
>      0.00      0.01      0.00      0.00      0.01      0.00      0.00      0.00 
> LIE_33.bg LIE_34.bg LIE_35.bg LIE_36.bg LIE_37.bg LIE_38.bg LIE_39.bg LIE_40.bg 
>      0.00      0.01      0.00      0.01      0.01      0.00      0.00      0.00 
> LIE_41.bg LIE_42.bg LIE_43.bg LIE_44.bg 
>      0.01      0.00      0.00      0.00 
> 
> To see the correlations between and within groups, use the short=FALSE option in your print statement.
> Many results are not shown directly. To see specific objects select from the following list:
>  mean sd n F ICC1 ICC2 ci1 ci2 raw rbg pbg rwg nw ci.wg pwg etabg etawg nwg nG Call

Factor structure quality

parameters::check_factorstructure(lie_EFA)

> # Is the data suitable for Factor Analysis?
> 
>   - KMO: The Kaiser, Meyer, Olkin (KMO) measure of sampling adequacy suggests that data seems appropriate for factor analysis (KMO = 0.94).
>   - Sphericity: Bartlett's test of sphericity suggests that there is sufficient significant correlation in the data for factor analaysis (Chisq(946) = 10773.22, p < .001).

Correlation matrix

cor <- as.matrix(correlation::correlation(lie_EFA))

How many factors

parameters::n_factors(lie_EFA, cor = cor, rotation = "varimax", package = "all", safe = FALSE) %T>% 
  print() %>%
  plot() +
  ggtitle("How many factors to retain (Pearson's correlations)") +
  theme_modern()

> # Method Agreement Procedure:
> 
> The choice of 4 dimensions is supported by 5 (20.00%) methods out of 25 (beta, R2, Velicer's MAP, BIC, BIC).

Exploratory Factor Analysis (EFA)

Four latent factors model

efa_4 <- psych::fa(cor, n.obs = nrow(lie_EFA), nfactors = 4, rotate = "varimax", fm = "ml") 

parameters::model_parameters(efa_4, labels = labels_lie$Description) %>% 
  print(sort = TRUE, threshold = "max") 

> # Rotated loadings from Factor Analysis (varimax-rotation)
> 
> Variable |                                                      Label |   ML1 |   ML2 |  ML4 |   ML3 | Complexity | Uniqueness
> ------------------------------------------------------------------------------------------------------------------------------
> LIE_10   |                                             I can lie well |  0.86 |       |      |       |       1.31 |       0.15
> LIE_9    |                                           I am a good liar |  0.83 |       |      |       |       1.36 |       0.20
> LIE_12   |                         I can lie effectively if I want to |  0.78 |       |      |       |       1.40 |       0.28
> LIE_14   |                    It is hard for others to detect my lies |  0.76 |       |      |       |       1.24 |       0.36
> LIE_18   |                   It is easy for me to make up clever lies |  0.74 |       |      |       |       1.46 |       0.33
> LIE_11   |                              I am good at deceiving others |  0.74 |       |      |       |       1.43 |       0.35
> LIE_13   |                      Others can easily tell when I’m lying | -0.73 |       |      |       |       1.26 |       0.40
> LIE_17   |                                     I find lying difficult | -0.66 |       |      |       |       1.84 |       0.38
> LIE_15   |                            I almost never get caught lying |  0.66 |       |      |       |       1.17 |       0.54
> LIE_20   |                    I do not have to prepare much for a lie |  0.61 |       |      |       |       1.84 |       0.48
> LIE_19   |                I find it taxing to come up with a good lie | -0.56 |       |      |       |       1.89 |       0.51
> LIE_16   |                 My lies often arouse suspicion from others | -0.49 |       |      |       |       1.46 |       0.71
> LIE_5    |                      I lie more often than most people do  |       |  0.75 |      |       |       1.39 |       0.33
> LIE_4    |                                   I have a tendency to lie |       |  0.74 |      |       |       1.25 |       0.39
> LIE_23   |           I find it difficult to refrain myself from lying |       |  0.74 |      |       |       1.06 |       0.44
> LIE_22   |                     I find myself lying without any reason |       |  0.73 |      |       |       1.16 |       0.43
> LIE_1    |                                           I lie frequently |       |  0.73 |      |       |       1.55 |       0.33
> LIE_6    |         I lie more frequently than what I expect myself to |       |  0.72 |      |       |       1.23 |       0.42
> LIE_7    |                           I lie more than I think I should |       |  0.71 |      |       |       1.17 |       0.45
> LIE_2    |                                   I lie in many situations |       |  0.64 |      |       |       2.10 |       0.38
> LIE_29   |                             I lie whenever it’s convenient |       |  0.59 |      |       |       1.82 |       0.51
> LIE_8    |                            Others lie less often than I do |       |  0.58 |      |       |       1.48 |       0.59
> LIE_21   |                          I have to try hard to avoid lying |       |  0.53 |      |       |       1.08 |       0.70
> LIE_26   |                                              I enjoy lying |       |  0.53 |      |       |       2.22 |       0.51
> LIE_31   |       I lie if it’s the most direct way to get what I want |       |  0.48 |      |       |       2.32 |       0.60
> LIE_24   |                  It is easy to hold back from telling lies |       | -0.41 |      |       |       1.36 |       0.80
> LIE_28   |                I feel satisfied when others believe my lie |       |  0.33 |      |       |       3.62 |       0.69
> LIE_25   |                                  I feel guilty after lying |       |       | 0.64 |       |       1.58 |       0.47
> LIE_44   |                                          It is bad to lie  |       |       | 0.63 |       |       1.28 |       0.54
> LIE_41   |                             Lying is against my principles |       |       | 0.62 |       |       1.97 |       0.44
> LIE_34   |                              I always avoid lying if I can |       |       | 0.55 |       |       1.97 |       0.51
> LIE_27   |                        I feel tense whenever I have to lie |       |       | 0.52 |       |       2.02 |       0.53
> LIE_36   | I prefer to tell the truth even if it gets me into trouble |       |       | 0.40 |       |       2.62 |       0.70
> LIE_35   |                 I would only lie if I have no other choice |       |       | 0.38 |       |       2.05 |       0.76
> LIE_37   |                      I would never lie for trivial matters |       |       | 0.33 |       |       1.47 |       0.86
> LIE_38   |                      I would never lie in serious contexts |       |       | 0.29 |       |       2.60 |       0.82
> LIE_43   |                               It is okay to lie sometimes  |       |       |      |  0.70 |       1.37 |       0.42
> LIE_33   |                                       I lie when necessary |       |       |      |  0.66 |       1.35 |       0.49
> LIE_42   |           It is acceptable to lie depending on the context |       |       |      |  0.63 |       1.40 |       0.52
> LIE_30   |              I lie when it’s easier than telling the truth |       |       |      |  0.52 |       1.85 |       0.61
> LIE_32   |            I lie when telling the truth is too troublesome |       |       |      |  0.49 |       2.21 |       0.62
> LIE_39   |            I would lie if something important was at stake |       |       |      |  0.45 |       1.42 |       0.75
> LIE_3    |                                          I never tell lies |       |       |      | -0.40 |       1.98 |       0.76
> LIE_40   |                         I would only lie if it is harmless |       |       |      |  0.35 |       1.85 |       0.83
> 
> The 4 latent factors (varimax rotation) accounted for 47.98% of the total variance of the original data (ML1 = 16.11%, ML2 = 15.99%, ML4 = 8.25%, ML3 = 7.62%).

One latent factors model

efa_1 <- psych::fa(cor, n.obs = nrow(lie_EFA), nfactors = 1, rotate = "varimax", fm = "ml") 

parameters::model_parameters(efa_1, labels = labels_lie$Description) %>% 
  print(sort = TRUE, threshold = "max") 

> # Rotated loadings from Factor Analysis (varimax-rotation)
> 
> Variable |                                                      Label |   ML1 | Complexity | Uniqueness
> -------------------------------------------------------------------------------------------------------
> LIE_10   |                                             I can lie well |  0.84 |       1.00 |       0.29
> LIE_9    |                                           I am a good liar |  0.83 |       1.00 |       0.31
> LIE_18   |                   It is easy for me to make up clever lies |  0.77 |       1.00 |       0.40
> LIE_11   |                              I am good at deceiving others |  0.77 |       1.00 |       0.41
> LIE_12   |                         I can lie effectively if I want to |  0.77 |       1.00 |       0.41
> LIE_14   |                    It is hard for others to detect my lies |  0.72 |       1.00 |       0.49
> LIE_17   |                                     I find lying difficult | -0.71 |       1.00 |       0.49
> LIE_20   |                    I do not have to prepare much for a lie |  0.71 |       1.00 |       0.49
> LIE_2    |                                   I lie in many situations |  0.67 |       1.00 |       0.55
> LIE_13   |                      Others can easily tell when I’m lying | -0.63 |       1.00 |       0.60
> LIE_1    |                                           I lie frequently |  0.62 |       1.00 |       0.62
> LIE_5    |                      I lie more often than most people do  |  0.62 |       1.00 |       0.62
> LIE_19   |                I find it taxing to come up with a good lie | -0.61 |       1.00 |       0.63
> LIE_15   |                            I almost never get caught lying |  0.59 |       1.00 |       0.65
> LIE_41   |                             Lying is against my principles | -0.58 |       1.00 |       0.66
> LIE_4    |                                   I have a tendency to lie |  0.57 |       1.00 |       0.67
> LIE_26   |                                              I enjoy lying |  0.56 |       1.00 |       0.68
> LIE_27   |                        I feel tense whenever I have to lie | -0.56 |       1.00 |       0.69
> LIE_28   |                I feel satisfied when others believe my lie |  0.54 |       1.00 |       0.71
> LIE_25   |                                  I feel guilty after lying | -0.53 |       1.00 |       0.71
> LIE_29   |                             I lie whenever it’s convenient |  0.53 |       1.00 |       0.72
> LIE_31   |       I lie if it’s the most direct way to get what I want |  0.52 |       1.00 |       0.73
> LIE_6    |         I lie more frequently than what I expect myself to |  0.51 |       1.00 |       0.74
> LIE_8    |                            Others lie less often than I do |  0.51 |       1.00 |       0.74
> LIE_34   |                              I always avoid lying if I can | -0.48 |       1.00 |       0.77
> LIE_22   |                     I find myself lying without any reason |  0.47 |       1.00 |       0.78
> LIE_7    |                           I lie more than I think I should |  0.46 |       1.00 |       0.78
> LIE_32   |            I lie when telling the truth is too troublesome |  0.46 |       1.00 |       0.79
> LIE_43   |                               It is okay to lie sometimes  |  0.46 |       1.00 |       0.79
> LIE_23   |           I find it difficult to refrain myself from lying |  0.46 |       1.00 |       0.79
> LIE_36   | I prefer to tell the truth even if it gets me into trouble | -0.46 |       1.00 |       0.79
> LIE_33   |                                       I lie when necessary |  0.44 |       1.00 |       0.80
> LIE_42   |           It is acceptable to lie depending on the context |  0.43 |       1.00 |       0.81
> LIE_44   |                                          It is bad to lie  | -0.42 |       1.00 |       0.83
> LIE_30   |              I lie when it’s easier than telling the truth |  0.41 |       1.00 |       0.83
> LIE_38   |                      I would never lie in serious contexts | -0.36 |       1.00 |       0.87
> LIE_3    |                                          I never tell lies | -0.32 |       1.00 |       0.90
> LIE_16   |                 My lies often arouse suspicion from others | -0.32 |       1.00 |       0.90
> LIE_39   |            I would lie if something important was at stake |  0.29 |       1.00 |       0.91
> LIE_21   |                          I have to try hard to avoid lying |  0.24 |       1.00 |       0.94
> LIE_37   |                      I would never lie for trivial matters | -0.23 |       1.00 |       0.95
> LIE_24   |                  It is easy to hold back from telling lies | -0.18 |       1.00 |       0.97
> LIE_35   |                 I would only lie if I have no other choice | -0.12 |       1.00 |       0.99
> LIE_40   |                         I would only lie if it is harmless |  0.06 |       1.00 |       1.00
> 
> The unique latent factor (varimax rotation) accounted for 29.04% of the total variance of the original data.

paste0("The model with one, and four factors accounted for ",
       report::format_text(c(insight::format_value(efa_1$Vaccounted[2,]*100),
                             insight::format_value(efa_4$Vaccounted[3, 4]*100))),
       "% of variance of the dataset.")

> [1] "The model with one, and four factors accounted for 29.04 and 47.98% of variance of the dataset."

The factor number exploration suggested the presence of four and one latent factor(s). We therefore decided to keep the unique and four-factors models and submitted their simple structure to Confirmatory Factor Analysis (CFA)

Confirmatory Factor Analysis (CFA)

Model Selection

report_cfa_indices <- function(comparison, row=1, name="<model>"){
  paste0("(X2", name, " = ", insight::format_value(comparison[row, "Chisq"]),
        ", AIC", name, " = ", insight::format_value(comparison[row, "AIC"]),
        ", BIC", name, " = ", insight::format_value(comparison[row, "BIC_adjusted"]),
        ", RMSEA", name, " = ", insight::format_value(comparison[row, "RMSEA"]),
        ", CFI", name, " = ", insight::format_value(comparison[row, "CFI"]),
        ", SRMR", name, " = ", insight::format_value(comparison[row, "SRMR"]),
        ")")
}

One vs. Four Factors

cfa_4 <- parameters::efa_to_cfa(efa_4, threshold = "max") %>% 
  lavaan::cfa(data = lie_CFA)
cfa_1 <- parameters::efa_to_cfa(efa_1, threshold = "max") %>% 
  lavaan::cfa(data = lie_CFA)

comparison <- performance::compare_performance(cfa_4, cfa_1) %>% 
  select(Model, AIC, BIC, BIC_adjusted, Chisq, RMSEA, CFI, SRMR)
comparison

Model	AIC	BIC	BIC_adjusted	Chisq	RMSEA	CFI	SRMR
cfa_4	53242	53586	53288	2184	0.07	0.80	0.10
cfa_1	55145	55467	55188	4100	0.11	0.51	0.14

paste0("The confirmatory factor analysis favoured the four-factors solution ", 
       report_cfa_indices(comparison, 1, name="<4-factors>"),
       " over the one-factor ",
       report_cfa_indices(comparison, 2, name="<1-factor>"))

> [1] "The confirmatory factor analysis favoured the four-factors solution (X2<4-factors> = 2184.35, AIC<4-factors> = 53241.67, BIC<4-factors> = 53287.58, RMSEA<4-factors> = 0.07, CFI<4-factors> = 0.80, SRMR<4-factors> = 0.10) over the one-factor (X2<1-factor> = 4100.08, AIC<1-factor> = 55145.41, BIC<1-factor> = 55188.38, RMSEA<1-factor> = 0.11, CFI<1-factor> = 0.51, SRMR<1-factor> = 0.14)"

Four-factors vs. Initial Model

# Initial Model
model_initial <- c()
for (dimension in unique(labels_lie$Dimension)) {
  model_initial <- c(
    model_initial,
    paste0(tools::toTitleCase(dimension), " =~ ", paste(as.character(labels_lie[labels_lie$Dimension == dimension, "Item"]), collapse = " + "))
  )
}
cfa_initial <- paste0(model_initial, collapse = "\n") %>% 
  lavaan::cfa(data = lie_CFA)

comparison <- performance::compare_performance(cfa_4, cfa_initial) %>% 
  select(Model, AIC, BIC, BIC_adjusted, Chisq, RMSEA, CFI, SRMR)
comparison

Model	AIC	BIC	BIC_adjusted	Chisq	RMSEA	CFI	SRMR
cfa_4	53242	53586	53288	2184	0.07	0.80	0.10
cfa_initial	53756	54090	53801	2705	0.08	0.72	0.11

paste0("We then compared the four-factors solution with the initial hypothetic model with which we built the scale, which favoured the four-factors model ", report_cfa_indices(comparison, 2, name="<hypothetic>"))

> [1] "We then compared the four-factors solution with the initial hypothetic model with which we built the scale, which favoured the four-factors model (X2<hypothetic> = 2705.16, AIC<hypothetic> = 53756.49, BIC<hypothetic> = 53800.93, RMSEA<hypothetic> = 0.08, CFI<hypothetic> = 0.72, SRMR<hypothetic> = 0.11)"

Short vs. Long Form

cfa_4_short3 <- parameters::efa_to_cfa(efa_4, threshold = 3, names = c( "Ability", "Frequency", "Negativity", "Contextuality")) %>% 
  lavaan::cfa(data = lie_CFA)
cfa_4_short4 <- parameters::efa_to_cfa(efa_4, threshold = 4, names = c( "Ability", "Frequency", "Negativity", "Contextuality")) %>% 
  lavaan::cfa(data = lie_CFA)
cfa_4_short5 <- parameters::efa_to_cfa(efa_4, threshold = 5, names = c( "Ability", "Frequency", "Negativity", "Contextuality")) %>% 
  lavaan::cfa(data = lie_CFA)

comparison <- performance::compare_performance(cfa_4, cfa_4_short3, cfa_4_short4, cfa_4_short5) %>% 
  select(Model, AIC, BIC, BIC_adjusted, Chisq, RMSEA, CFI, SRMR)
comparison

Model	AIC	BIC	BIC_adjusted	Chisq	RMSEA	CFI	SRMR
cfa_4	53242	53586	53288	2184	0.07	0.80	0.10
cfa_4_short3	14181	14291	14196	61	0.03	0.99	0.04
cfa_4_short4	18876	19015	18894	208	0.06	0.95	0.07
cfa_4_short5	23655	23823	23677	467	0.08	0.90	0.09

paste0("Finally, we compared the full four-factors model (including all items) with short form retaining only the 3, 4 or 5 most loading items for each of the 4 dimensions. The 3-items version ",
       report_cfa_indices(comparison, 2, name="<3-items>"),
       " outperformed all versions, including 5-items ",
       report_cfa_indices(comparison, 4, name="<5-items>"),
       " and 4-items ",
       report_cfa_indices(comparison, 3, name="<4-items>"), 
       ". Nonetheless, as 3-items per construct is the bare minimum for adequate reliability, we decided to keep the second best performing version with 4-items per factor, which also displayed excellent indices of fit."
      )

> [1] "Finally, we compared the full four-factors model (including all items) with short form retaining only the 3, 4 or 5 most loading items for each of the 4 dimensions. The 3-items version (X2<3-items> = 60.54, AIC<3-items> = 14181.35, BIC<3-items> = 14196.01, RMSEA<3-items> = 0.03, CFI<3-items> = 0.99, SRMR<3-items> = 0.04) outperformed all versions, including 5-items (X2<5-items> = 467.21, AIC<5-items> = 23654.95, BIC<5-items> = 23677.41, RMSEA<5-items> = 0.08, CFI<5-items> = 0.90, SRMR<5-items> = 0.09) and 4-items (X2<4-items> = 207.63, AIC<4-items> = 18875.55, BIC<4-items> = 18894.11, RMSEA<4-items> = 0.06, CFI<4-items> = 0.95, SRMR<4-items> = 0.07). Nonetheless, as 3-items per construct is the bare minimum for adequate reliability, we decided to keep the second best performing version with 4-items per factor, which also displayed excellent indices of fit."

Model Description

# Refit the cfa model with the full sample
cfa_4_short4_full <- parameters::efa_to_cfa(efa_4, threshold = 4, names = c( "Ability", "Frequency", "Negativity", "Contextuality")) %>% 
  lavaan::cfa(data = lie)

cfa_parameters <- model_parameters(cfa_4_short4_full, standardize = FALSE)
cfa_parameters

	To	Operator	From	Coefficient	SE	CI_low	CI_high	p	Type
1	Ability	=~	LIE_9	1.00	0.00	1.00	1.00	0	Loading
2	Ability	=~	LIE_10	1.01	0.03	0.96	1.06	0	Loading
3	Ability	=~	LIE_12	0.88	0.03	0.82	0.94	0	Loading
4	Ability	=~	LIE_14	0.78	0.03	0.73	0.83	0	Loading
5	Frequency	=~	LIE_4	1.00	0.00	1.00	1.00	0	Loading
6	Frequency	=~	LIE_5	0.91	0.04	0.83	0.99	0	Loading
7	Frequency	=~	LIE_22	0.79	0.04	0.71	0.88	0	Loading
8	Frequency	=~	LIE_23	0.82	0.04	0.74	0.91	0	Loading
9	Negativity	=~	LIE_25	1.00	0.00	1.00	1.00	0	Loading
10	Negativity	=~	LIE_34	0.81	0.06	0.69	0.92	0	Loading
11	Negativity	=~	LIE_41	1.28	0.08	1.12	1.44	0	Loading
12	Negativity	=~	LIE_44	1.01	0.07	0.87	1.15	0	Loading
13	Contextuality	=~	LIE_30	1.00	0.00	1.00	1.00	0	Loading
14	Contextuality	=~	LIE_33	1.28	0.13	1.02	1.53	0	Loading
15	Contextuality	=~	LIE_42	1.47	0.15	1.18	1.75	0	Loading
16	Contextuality	=~	LIE_43	1.58	0.15	1.28	1.88	0	Loading
37	Ability	~~	Frequency	2.15	0.23	1.70	2.60	0	Correlation
38	Ability	~~	Negativity	-1.89	0.20	-2.29	-1.50	0	Correlation
39	Ability	~~	Contextuality	1.34	0.18	1.00	1.69	0	Correlation
40	Frequency	~~	Negativity	-1.72	0.18	-2.06	-1.37	0	Correlation
41	Frequency	~~	Contextuality	0.65	0.12	0.41	0.88	0	Correlation
42	Negativity	~~	Contextuality	-0.78	0.12	-1.01	-0.56	0	Correlation

data <- see::data_plot(cfa_parameters, ci=FALSE)

data$nodes <- mutate(data$nodes, Name = stringr::str_replace(Name, "LIE_", "Q")) 
data$edges <- mutate(data$edges, from = stringr::str_replace(from, "LIE_", "Q"))

tidygraph::tbl_graph(data$nodes, data$edges) %>%
  ggraph::ggraph(layout = 'fr') +
  ggraph::geom_edge_arc(aes(alpha = as.numeric(Type == "Correlation"),
                    label = Label_Correlation,
                    color = Coefficient),
                    strength = 0.1,
                    edge_width = 1.5,
                    label_dodge = unit(2, "mm"),
                    linetype = 1, angle_calc = "along",
                    label_size = 3,
                    start_cap = ggraph::circle(0, 'mm'), end_cap = ggraph::circle(0, 'mm')) +
  ggraph::geom_edge_link(aes(alpha = as.numeric(Type == "Loading"),
                     label = Label_Loading,
                     color = Coefficient),
                     label_dodge = unit(2, "mm"),
                     angle_calc = "along", 
                     edge_width = 0.9,
                     label_size = 3,
                     check_overlap = TRUE,
                     arrow = arrow(type = "closed", length = unit(3, "mm")),
                     start_cap = ggraph::circle(0, 'mm'), end_cap = ggraph::circle(-12, 'mm')) +
  ggraph::geom_node_point(aes(colour = Name, size = Latent)) +
  ggraph::geom_node_text(aes(label = Name))  +
  ggraph::scale_edge_colour_gradient2(
    guide = FALSE,
    high = "#4CAF50",
    mid = "#FFF9C4",
    low = "#E91E63"
  ) +
  scale_alpha(guide = FALSE, range = c(0, 1)) +
  scale_size_manual(values=c("TRUE"=33, "FALSE"=22)) +
  scale_color_manual(values=c("Negativity"="#E91E63", "Q41"="#EC407A", "Q44"="#F06292", "Q34"="#F48FB1", "Q25"="#F8BBD0",
                              "Contextuality"="#FF9800", "Q43"="#FFA726", "Q42"="#FFB74D", "Q33"="#FFCC80", "Q30"="#FFE0B2",
                              "Frequency"="#4CAF50", "Q4"="#66BB6A", "Q5"="#81C784", "Q22"="#A5D6A7", "Q23"="#C8E6C9",
                              "Ability"="#2196F3", "Q10"="#42A5F5", "Q9"="#64B5F6", "Q12"="#90CAF9", "Q14"="#BBDEFB")) +
  ggraph::scale_edge_alpha(guide = FALSE, range = c(0, 1)) +
  scale_x_continuous(expand = expansion(c(0.07, 0.07))) +
  scale_y_continuous(expand = expansion(c(0.07, 0.07))) +
  ggraph::theme_graph() +
  theme(legend.position = "none")

Loadings Table

table_efa <- as.data.frame(sort(parameters::model_parameters(efa_4, labels = labels_lie$Description)))[,1:6] %>% 
  mutate(Variable = as.character(Variable)) %>% 
  mutate_if(is.numeric, insight::format_value)
names(table_efa) <- c("Item", "Label", "Ability", "Frequency", "Negativity", "Contextuality")

table_cfa <- as.data.frame(parameters::model_parameters(cfa_4_short4_full)) %>% 
  filter(Type == "Loading") %>% 
  select(To, Item=From, Coefficient) %>% 
  pivot_wider(names_from=To, values_from=Coefficient, names_prefix="CFA_") %>% 
  mutate(Item = as.character(Item)) 

table <- full_join(table_efa, table_cfa, by="Item") %>% 
  mutate_if(is.numeric, insight::format_value) %>% 
  mutate(Frequency = paste0(Frequency, " [", CFA_Frequency, "]"),
         Ability = paste0(Ability, " [", CFA_Ability, "]"),
         Negativity = paste0(Negativity, " [", CFA_Negativity, "]"),
         Contextuality = paste0(Contextuality, " [", CFA_Contextuality, "]"),
         Item = stringr::str_replace(Item, "LIE_", "Q")) %>% 
  mutate_all(function(x) stringr::str_remove_all(x, " \\[]")) %>% 
  select(Item, Label, Frequency, Ability, Negativity, Contextuality)
write.csv(table, "figures/table_loadings.csv", row.names = FALSE)

Compute Scores

lie <- predict(cfa_parameters)
names(lie) <- paste0("LIE_", names(lie))

lie %>% 
  select(starts_with("LIE_")) %>% 
  report() %>% 
  table_long() %>% 
  select(-one_of(c("n_Obs", "Median", "MAD", "n_Missing"))) %>% 
  print()

> Variable          |      Mean |   SD |   Min |  Max | Skewness | Kurtosis
> -------------------------------------------------------------------------
> LIE_Ability       | -3.03e-17 | 2.38 | -5.43 | 4.58 |    -0.34 |    -0.61
> LIE_Frequency     | -7.84e-19 | 1.86 | -3.36 | 6.76 |     0.26 |    -0.50
> LIE_Negativity    |  1.73e-17 | 1.40 | -5.34 | 3.11 |    -0.11 |    -0.07
> LIE_Contextuality |  2.82e-17 | 1.00 | -3.88 | 2.02 |    -0.94 |     1.72

p_distrib <- lie %>% 
  select(starts_with("LIE_")) %>% 
  dplyr::rename_all(.funs = list(~ sub("LIE_*", "", .))) %>%
  bayestestR::estimate_density(method = "KernSmooth") %>% 
  see::data_plot() %>% 
  mutate(Parameter = fct_relevel(Parameter, "Ability", "Frequency", "Negativity", "Contextuality")) %>% 
  ggplot(aes(x=x, y=y, color=Parameter)) +
  geom_line(size=2) +
  # ggtitle("Distribution of the LIE dimensions") +
  xlab("Score\n") +
  ylab("Distribution") +
  theme_modern() +
  scale_color_manual(values=c("Ability"= "#2196F3", "Frequency"="#4CAF50", "Negativity"="#E91E63", "Contextuality"="#FF9800"), name = "Dimensions")

Reliability

Cronbach’s alpha

paste0("All subscales of the LIE scale, namely, Frequency (alpha = ",
       insight::format_value(performance::cronbachs_alpha(select(df, LIE_1, LIE_4, LIE_5, LIE_23))),
       "), Ability (alpha = ",
        insight::format_value(performance::cronbachs_alpha(select(df, LIE_9, LIE_10, LIE_14, LIE_18))),
       "), Contextuality (alpha = ",
        insight::format_value(performance::cronbachs_alpha(select(df, LIE_33, LIE_39, LIE_42, LIE_43))),
       ") and Negativity (alpha = ", 
        insight::format_value(performance::cronbachs_alpha(select(df, LIE_25, LIE_34, LIE_41, LIE_44))),
       ") have a high reliability.")

> [1] "All subscales of the LIE scale, namely, Frequency (alpha = 0.86), Ability (alpha = 0.92), Contextuality (alpha = 0.77) and Negativity (alpha = 0.77) have a high reliability."

# library(formattable)

questions <- dplyr::select(df, dplyr::one_of(row.names(lavaan::lavInspect(cfa_4_short4_full)$lambda)))


om <- psych::omega(m = questions, nfactors = 4, fm = "ml", title = "Omega of LIE Scale", plot = "FALSE", n.obs = nrow(questions), flip=FALSE) # ωh = 0.36, ωt = 0.83 

# Table of omega coefficients
table_om <- om$omega.group
rownames(table_om) <- c("All items","Ability", "Frequency", "Negativity", "Contextuality")
colnames(table_om) <- c("Omega (total)", "Omega (hierarchical)", "Omega (group)")
table_om

	Omega (total)	Omega (hierarchical)	Omega (group)
All items	0.84	0.39	0.50
Ability	0.92	0.49	0.43
Frequency	0.85	0.25	0.60
Negativity	0.78	0.29	0.49
Contextuality	0.77	0.34	0.43

# Table of variance accounted for
table_variance <- om$omega.group %>%
  mutate(Composite = c("All items", "Ability", "Frequency", "Negativity", "Contextuality")) %>%
  mutate(Total = total*100,
         General = general*100,
         Group = group*100) %>%
  select(Composite, Total, General, Group)
colnames(table_variance) <- c("Composite", "Total Variance (%)", "Variance due to General Factor (%)", "Variance due to Group Factor (%)")
table_variance 

Composite	Total Variance (%)	Variance due to General Factor (%)	Variance due to Group Factor (%)
All items	84	39	50
Ability	92	49	43
Frequency	85	25	60
Negativity	78	29	49
Contextuality	77	34	43

psych::cor.plot(om)

Cluster Structure

Cluster Tendency

parameters::check_clusterstructure(lie, standardize = FALSE) %T>%
  print() %>%
  plot()

> # Clustering tendency
> 
> The dataset is suitable for clustering (Hopkins' H = 0.21).

How many clusters

parameters::n_clusters(lie, standardize = FALSE) %T>%
  print() %>% 
  plot() +
  theme_modern()

> # Method Agreement Procedure:
> 
> The choice of 3 clusters is supported by 7 (25.00%) methods out of 28 (Scott, TrCovW, Friedman, Ratkowsky, Ball, SDindex, Mixture).

The agreement procedure, combining 28 different methods for determining the optimal number of clusters, supported the existence of 2 (8/28) or 3 (11/28) clusters.

Clustering

K-means

set.seed(333)

k2 <- kmeans(lie, centers=2, iter.max = 10000, nstart = 1000)
k3 <- kmeans(lie, centers=3, iter.max = 10000, nstart = 1000)

model_parameters(k2) 

Cluster	n_Obs	Sum_Squares	LIE_Ability	LIE_Frequency	LIE_Negativity	LIE_Contextuality
1	450	2959	1.4	0.83	-0.66	0.38
2	266	1813	-2.3	-1.40	1.12	-0.64

model_parameters(k3) 

Cluster	n_Obs	Sum_Squares	LIE_Ability	LIE_Frequency	LIE_Negativity	LIE_Contextuality
1	308	1576	0.0	-0.41	0.18	-0.01
2	258	1332	2.0	1.63	-1.12	0.55
3	150	697	-3.4	-1.97	1.56	-0.93

paste0("We applied k-means clustering, which revealed that grouping the participants in 2 and 3 clusters would account for ",
       insight::format_value(attributes(model_parameters(k2))$variance*100),
       "% and ",
       insight::format_value(attributes(model_parameters(k3))$variance*100),
       "% of the total variance of the four dimensions of the questionnaire, respectively.",
       " Thus, we decided to go ahead with the latter solution.")

> [1] "We applied k-means clustering, which revealed that grouping the participants in 2 and 3 clusters would account for 44.64% and 58.18% of the total variance of the four dimensions of the questionnaire, respectively. Thus, we decided to go ahead with the latter solution."

Compute Profiles

lie$LIE_Profile <- model_parameters(k3) %>% 
  predict(names = c("Average", "Trickster", "Virtuous")) 

paste0('We then assigned each participant to its nearest cluster, labelling them as Average (',
       insight::format_value(sum(lie$LIE_Profile=="Average")/nrow(lie)*100),
       "% of the sample; people that report an average lying ability, slightly lower than average frequency, average negativity and contextuality), Trickster (",
       insight::format_value(sum(lie$LIE_Profile=="Trickster")/nrow(lie)*100),
       "%; people with high reported lying ability, frequency, low negative experience associated with deception and above-average flexibility in its implementation), and Virtuous (",
       insight::format_value(sum(lie$LIE_Profile=="Virtuous")/nrow(lie)*100),
       "%; people with very low reported lying ability and frequency, strong negative emotions and moral attitude associated with lying and high rigidity in their (non-)usage of deception).")

> [1] "We then assigned each participant to its nearest cluster, labelling them as Average (43.02% of the sample; people that report an average lying ability, slightly lower than average frequency, average negativity and contextuality), Trickster (36.03%; people with high reported lying ability, frequency, low negative experience associated with deception and above-average flexibility in its implementation), and Virtuous (20.95%; people with very low reported lying ability and frequency, strong negative emotions and moral attitude associated with lying and high rigidity in their (non-)usage of deception)."

Visualisation

colors_cluster <- c("Average" = "#D500F9", "Trickster" = "#F50057", "Virtuous" = "#3D5AFE")

p_profiles <- lie %>% 
  select(starts_with("LIE_")) %>% 
  pivot_longer(-LIE_Profile, names_to = "Dimension", values_to = "Score") %>%
  mutate(LIE_Profile = fct_relevel(LIE_Profile, "Trickster", "Average", "Virtuous"),
         Dimension = str_remove(Dimension, "LIE_"),
         Dimension = fct_relevel(Dimension, "Ability", "Frequency", "Negativity", "Contextuality")) %>% 
  group_by(LIE_Profile, Dimension) %>% 
  summarise_all(mean) %>%
  rename(Profile = LIE_Profile) %>% 
  ggplot(aes(x = Dimension, y = Score, color = Profile, group = Profile)) +
  geom_line(key_glyph = "label") +
  geom_polygon(fill = NA, size = 2.5, show.legend = FALSE) +
  scale_color_manual(values = colors_cluster) +
  theme_minimal() +
  xlab("") + ylab("") +
  scale_y_continuous(breaks = c(-2, 0, 2), expand = expansion(c(.10, 0))) +
  # scale_y_continuous(limits = c(-5, 5)) +
  theme(axis.ticks.y = element_blank(),
        axis.text.y = element_blank(),
        legend.title = element_text(face="bold", size=15),
        panel.grid.major.y = element_line(color="#E0E0E0", linetype="longdash"),
        panel.grid.major.x = element_blank(),
        legend.text = element_text(size=13),
        axis.text.x = element_text(
          vjust = -0.5,
          size = 13,
          # face="bold",
          color="black")) +
  coord_radar(start = -pi/4, clip="off")

# Combine plots
cowplot::plot_grid(p_distrib, p_profiles, nrow=2, labels = c('A', 'B'), label_size = 14)

Convergent Validity

df <- cbind(df, lie) %>%
  select(-matches("LIE_\\d"))

Demographics

Sex

library(rstanarm)

model_dimensional <- stan_glm(Sex ~ LIE_Ability + LIE_Frequency + LIE_Contextuality + LIE_Negativity, data=df, family = "binomial", refresh = 0, seed=333)
model_profile <- stan_glm(Sex ~ LIE_Profile, data = df, family = "binomial", refresh = 0, seed=333)

performance::compare_performance(model_dimensional, model_profile, metrics = c("LOOIC", "R2"))

Model	Type	ELPD	ELPD_SE	LOOIC	LOOIC_SE	R2
model_dimensional	stanreg	-486	5.6	971	11	0.03
model_profile	stanreg	-486	5.2	971	10	0.03

parameters::parameters_table(model_parameters(model_profile))

Parameter	Median	89% CI	pd	% in ROPE	Rhat	ESS	Prior
(Intercept)	-0.37	[-0.54, -0.18]	99.95%	4.38%	0.999	3016	Normal (0 +- 10.00)
LIE_Profile [Trickster]	0.53	[ 0.26, 0.80]	99.95%	2.08%	1.000	3258	Normal (0 +- 2.50)
LIE_Profile [Virtuous]	-0.31	[-0.62, 0.06]	92.00%	27.38%	1.000	3034	Normal (0 +- 2.50)

parameters::parameters_table(model_parameters(model_dimensional))

	Parameter	Median	89% CI	pd	% in ROPE	Rhat	ESS	Prior
1	(Intercept)	-0.24	[-0.36, -0.11]	99.83%	20.70%	1.000	3682	Normal (0 +- 10.00)
2	LIE_Ability	0.11	[ 0.04, 0.18]	99.20%	96.25%	1.001	2811	Normal (0 +- 1.05)
4	LIE_Frequency	0.08	[-0.01, 0.17]	93.62%	95.85%	1.002	3291	Normal (0 +- 1.35)
3	LIE_Contextuality	-0.10	[-0.25, 0.06]	84.60%	79.33%	1.000	2988	Normal (0 +- 2.49)
5	LIE_Negativity	-0.06	[-0.19, 0.07]	74.28%	93.00%	1.001	2755	Normal (0 +- 1.78)

model_profile %>%
  estimate_means() %>%
  mutate(LIE_Profile = fct_relevel(LIE_Profile, "Trickster", "Average", "Virtuous")) %>%
  ggplot(aes(x = LIE_Profile, y = Probability, color = LIE_Profile)) +
  geom_line(aes(group = 1), size = 1) +
  geom_pointrange(aes(ymin = CI_low, ymax = CI_high), size = 1) +
  theme_modern() +
  scale_color_manual(values = colors_cluster, guide = FALSE) +
  ylab("Probability of being a Male") +
  xlab("Deception Profile")

df %>%
  select(Participant, Sex, starts_with("LIE_"), -LIE_Profile) %>%
  pivot_longer(-c(Sex, Participant), names_to = "Dimension", values_to = "Score") %>%
  mutate(Dimension = str_remove(Dimension, "LIE_"),
         Dimension = fct_relevel(Dimension, "Ability", "Frequency", "Negativity", "Contextuality")) %>%
  ggplot(aes(x = Dimension, y = Score)) +
  geom_boxplot(aes(fill = Sex, color = Sex)) +
  scale_fill_manual(values = c("Male" = "#2196F3", "Female" = "#F06292")) +
  scale_color_manual(values = c("Male" = "#2196F3", "Female" = "#F06292")) +
  theme_modern() +
  coord_flip()

sig <- model_parameters(model_dimensional)[-1,] %>%
  select(Parameter, pd) %>%
  mutate(Dimension = stringr::str_remove(Parameter, "LIE_"),
         Text = insight::format_pd(pd, stars_only=TRUE),
         Predicted = 0.6,
         Score = df %>%
           select(one_of(Parameter)) %>%
           summarise_all(function(x) {mean(range(x))}) %>%
           t()) %>%
  mutate(Dimension = fct_relevel(Dimension, "Ability", "Frequency", "Negativity", "Contextuality"))

p_sex <- rbind(estimate_link(model_dimensional, target="LIE_Ability") %>%
        mutate(LIE_Frequency = NA, LIE_Contextuality=NA, LIE_Negativity=NA),
      estimate_link(model_dimensional, target="LIE_Frequency") %>%
        mutate(LIE_Ability = NA, LIE_Contextuality=NA, LIE_Negativity=NA),
      estimate_link(model_dimensional, target="LIE_Contextuality") %>%
        mutate(LIE_Frequency = NA, LIE_Ability=NA, LIE_Negativity=NA),
      estimate_link(model_dimensional, target="LIE_Negativity") %>%
        mutate(LIE_Frequency = NA, LIE_Contextuality=NA, LIE_Ability=NA)) %>%
  pivot_longer(cols=starts_with("LIE_"), names_to="Dimension", values_to = "Score") %>%
  mutate(Dimension = str_remove(Dimension, "LIE_"),
         Dimension = fct_relevel(Dimension, "Ability", "Frequency", "Negativity", "Contextuality")) %>%
  ggplot(aes(x = Score, y = Predicted)) +
  geom_ribbon(aes(ymin=CI_low, ymax=CI_high, fill=Dimension), alpha=0.1) +
  geom_line(aes(color=Dimension), size = 1) +
  geom_text(data = sig, aes(label = Text)) +
  theme_modern() +
  theme(strip.placement = "outside",
        strip.text = element_text(size=13, face="plain"),
        axis.title = element_text(size=13),
        axis.text = element_text(size=9),
        plot.title = element_text(face="bold", hjust = 0.5)) +
  ggtitle("Sex") +
  ylab("Probability of being a Male") +
  xlab("") +
  scale_color_manual(values=c("Ability"= "#2196F3", "Frequency"="#4CAF50", "Negativity"="#E91E63", "Contextuality"="#FF9800"), name = "Dimensions", guide=FALSE) +
   scale_fill_manual(values=c("Ability"= "#2196F3", "Frequency"="#4CAF50", "Negativity"="#E91E63", "Contextuality"="#FF9800"), name = "Dimensions", guide=FALSE) +
  facet_wrap(~Dimension, scales="free_x", strip.position = "bottom")

Age

model_dimensional <- stan_lmer(Age ~ LIE_Ability + LIE_Frequency + LIE_Contextuality + LIE_Negativity + Income + Education + (1|Sex), data = df, refresh = 0, seed=333)
model_profile <- stan_lmer(Age ~ LIE_Profile + Income + Education + (1|Sex), data = df, refresh = 0, seed=333)

performance::compare_performance(model_dimensional, model_profile)

Model	Type	ELPD	ELPD_SE	LOOIC	LOOIC_SE	WAIC	R2	R2_marginal	R2_adjusted	RMSE
model_dimensional	stanreg	-1979	40	3958	79	3958	0.27	0.27	0.24	5.9
model_profile	stanreg	-1980	40	3961	80	3961	0.26	0.26	0.24	6.0

parameters::parameters_table(model_parameters(model_profile))

	Parameter	Median	89% CI	pd	% in ROPE	Rhat	ESS	Prior
1	(Intercept)	31.12	[29.10, 33.39]	100%	0%	1.004	789	Normal (0 +- 69.26)
4	LIE_Profile [Trickster]	-0.55	[-1.37, 0.36]	83.33%	59.25%	1.000	2883	Normal (0 +- 17.31)
5	LIE_Profile [Virtuous]	1.56	[ 0.58, 2.65]	99.20%	8.75%	1.000	3199	Normal (0 +- 17.31)
3	Income	1.41e-04	[ 0.00, 0.00]	99.20%	100%	1.000	3744	Normal (0 +- 0.00)
2	Education	-1.84	[-2.06, -1.65]	100%	0%	1.001	3527	Normal (0 +- 8.97)

parameters::parameters_table(model_parameters(model_dimensional))

	Parameter	Median	89% CI	pd	% in ROPE	Rhat	ESS	Prior
1	(Intercept)	31.12	[28.44, 33.71]	100%	0%	1.090	38	Normal (0 +- 69.26)
4	LIE_Ability	-0.23	[-0.47, -0.01]	95.15%	99.95%	1.008	429	Normal (0 +- 7.41)
6	LIE_Frequency	0.04	[-0.26, 0.30]	60.15%	100%	1.002	2222	Normal (0 +- 9.29)
5	LIE_Contextuality	-0.61	[-1.11, -0.13]	96.83%	60.82%	1.003	1250	Normal (0 +- 17.30)
7	LIE_Negativity	0.00	[-0.40, 0.42]	50.85%	99.35%	1.002	1312	Normal (0 +- 12.30)
3	Income	1.40e-04	[ 0.00, 0.00]	99.45%	100%	1.002	2341	Normal (0 +- 0.00)
2	Education	-1.82	[-2.01, -1.62]	100%	0%	1.004	1616	Normal (0 +- 8.97)

model_profile %>%
  estimate_means() %>%
  mutate(LIE_Profile = fct_relevel(LIE_Profile, "Trickster", "Average", "Virtuous")) %>%
  ggplot(aes(x = LIE_Profile, y = Mean, color = LIE_Profile)) +
  geom_line(aes(group = 1), size = 1) +
  geom_pointrange(aes(ymin = CI_low, ymax = CI_high), size = 1) +
  theme_modern() +
  scale_color_manual(values = colors_cluster, guide = FALSE) +
  ylab("Age") +
  xlab("Deception Profile")

sig <- model_parameters(model_dimensional)[2:5,] %>%
  select(Parameter, pd) %>%
  mutate(Dimension = stringr::str_remove(Parameter, "LIE_"),
         Text = format_pd(pd, stars_only=TRUE),
         Predicted = 29,
         Score = df %>%
           select(one_of(Parameter)) %>%
           summarise_all(function(x) {mean(range(x))}) %>%
           t()) %>%
  mutate(Dimension = fct_relevel(Dimension, "Ability", "Frequency", "Negativity", "Contextuality"))

p_age <- rbind(estimate_link(model_dimensional, target="LIE_Frequency") %>%
        mutate(LIE_Ability = NA, LIE_Contextuality=NA, LIE_Negativity=NA),
      estimate_link(model_dimensional, target="LIE_Ability") %>%
        mutate(LIE_Frequency = NA, LIE_Contextuality=NA, LIE_Negativity=NA),
      estimate_link(model_dimensional, target="LIE_Contextuality") %>%
        mutate(LIE_Frequency = NA, LIE_Ability=NA, LIE_Negativity=NA),
      estimate_link(model_dimensional, target="LIE_Negativity") %>%
        mutate(LIE_Frequency = NA, LIE_Contextuality=NA, LIE_Ability=NA)) %>%
  pivot_longer(cols=starts_with("LIE_"), names_to="Dimension", values_to = "Score") %>%
  mutate(Dimension = str_remove(Dimension, "LIE_"),
         Dimension = fct_relevel(Dimension, "Ability", "Frequency", "Negativity", "Contextuality")) %>%
  ggplot(aes(x = Score, y = Predicted)) +
  geom_ribbon(aes(ymin=CI_low, ymax=CI_high, fill=Dimension), alpha=0.1) +
  geom_line(aes(color=Dimension), size = 1) +
  geom_text(data = sig, aes(label = Text)) +
  theme_modern() +
  theme(strip.placement = "outside",
        strip.text = element_text(size=13, face="plain"),
        axis.title = element_text(size=13),
        axis.text = element_text(size=9),
        plot.title = element_text(face="bold", hjust = 0.5)) +
  ggtitle("Age") +
  ylab("\nAge") +
  xlab("") +
  scale_color_manual(values=c("Frequency"="#4CAF50", "Ability"= "#2196F3", "Negativity"="#E91E63", "Contextuality"="#FF9800"), name = "Dimensions", guide=FALSE) +
   scale_fill_manual(values=c("Frequency"="#4CAF50", "Ability"= "#2196F3", "Negativity"="#E91E63", "Contextuality"="#FF9800"), name = "Dimensions", guide=FALSE) +
  facet_wrap(~Dimension, scales="free_x", strip.position = "bottom")

Education

model_profile <- stan_lmer(Education ~ LIE_Profile + Age + (1|Sex), data = df, refresh = 0, seed=333)
model_dimensional <- stan_lmer(Education ~ LIE_Ability + LIE_Frequency + LIE_Contextuality + LIE_Negativity + Age + (1|Sex), data = df, refresh = 0, seed=333)

performance::compare_performance(model_dimensional, model_profile)

Model	Type	ELPD	ELPD_SE	LOOIC	LOOIC_SE	WAIC	R2	R2_marginal	R2_adjusted	RMSE
model_dimensional	stanreg	-1388	34	2775	68	2775	0.26	0.26	0.24	1.7
model_profile	stanreg	-1384	34	2768	68	2768	0.26	0.26	0.24	1.7

parameters::parameters_table(model_parameters(model_profile))

	Parameter	Median	89% CI	pd	% in ROPE	Rhat	ESS	Prior
1	(Intercept)	7.07	[ 6.28, 7.75]	100%	0%	1.005	788	Normal (0 +- 19.53)
3	LIE_Profile [Trickster]	-0.45	[-0.69, -0.22]	99.85%	3.72%	1.000	3087	Normal (0 +- 4.88)
4	LIE_Profile [Virtuous]	0.22	[-0.05, 0.50]	90.30%	42.70%	1.000	2926	Normal (0 +- 4.88)
2	Age	-0.14	[-0.15, -0.12]	100%	100%	1.000	3443	Normal (0 +- 0.69)

parameters::parameters_table(model_parameters(model_dimensional))

	Parameter	Median	89% CI	pd	% in ROPE	Rhat	ESS	Prior
1	(Intercept)	6.95	[ 6.24, 7.73]	100%	0%	1.013	444	Normal (0 +- 19.53)
3	LIE_Ability	-0.05	[-0.10, 0.01]	91.38%	100%	0.999	3180	Normal (0 +- 2.06)
5	LIE_Frequency	-0.11	[-0.18, -0.04]	99.40%	96.67%	0.999	3052	Normal (0 +- 2.63)
4	LIE_Contextuality	0.02	[-0.10, 0.16]	60.98%	97.82%	1.000	2934	Normal (0 +- 4.87)
6	LIE_Negativity	-0.03	[-0.14, 0.08]	67.05%	98.92%	1.000	2748	Normal (0 +- 3.50)
2	Age	-0.14	[-0.15, -0.12]	100%	100%	1.000	3461	Normal (0 +- 0.69)

model_profile %>%
  estimate_means() %>%
  mutate(LIE_Profile = fct_relevel(LIE_Profile, "Trickster", "Average", "Virtuous")) %>%
  ggplot(aes(x = LIE_Profile, y = Mean, color = LIE_Profile)) +
  geom_line(aes(group = 1), size = 1) +
  geom_pointrange(aes(ymin = CI_low, ymax = CI_high), size = 1) +
  theme_modern() +
  scale_color_manual(values = colors_cluster, guide = FALSE) +
  ylab("Education (in years)") +
  xlab("Deception Profile")

Income

model_dimensional <- stan_lmer(Income ~ LIE_Ability + LIE_Frequency + LIE_Contextuality + LIE_Negativity + Age + Education + (1|Sex), data = df, refresh = 0, seed=333)
model_profile <- stan_lmer(Income ~ LIE_Profile + Age + Education + (1|Sex), data = df, refresh = 0, seed=333)

performance::compare_performance(model_dimensional, model_profile)

Model	Type	ELPD	ELPD_SE	LOOIC	LOOIC_SE	WAIC	R2	R2_marginal	R2_adjusted	RMSE
model_dimensional	stanreg	-6044	139	12087	278	12107	0.05	0.05	0.01	4259
model_profile	stanreg	-6043	138	12086	275	12110	0.04	0.04	0.01	4278

parameters::parameters_table(model_parameters(model_profile))

	Parameter	Median	89% CI	pd	% in ROPE	Rhat	ESS	Prior
1	(Intercept)	-813.36	[-2819.17, 1085.59]	75.10%	22.90%	1.002	1099	Normal (0 +- 43583.53)
4	LIE_Profile [Trickster]	274.76	[ -352.58, 913.93]	75.17%	62.28%	1.000	2343	Normal (0 +- 10895.88)
5	LIE_Profile [Virtuous]	-400.26	[-1139.97, 376.44]	80.00%	48.90%	1.001	2861	Normal (0 +- 10895.88)
2	Age	73.48	[ 28.81, 120.61]	99.62%	100%	1.002	2271	Normal (0 +- 1573.27)
3	Education	487.09	[ 318.65, 652.46]	100%	30.73%	1.002	2248	Normal (0 +- 5643.76)

parameters::parameters_table(model_parameters(model_dimensional))

	Parameter	Median	89% CI	pd	% in ROPE	Rhat	ESS	Prior
1	(Intercept)	-716.13	[-2961.26, 1368.37]	72.80%	21.80%	1.071	69	Normal (0 +- 43583.53)
4	LIE_Ability	222.05	[ 66.74, 378.14]	99.12%	98.15%	1.003	1550	Normal (0 +- 4661.19)
6	LIE_Frequency	58.29	[ -130.90, 255.33]	68.73%	99.90%	1.011	1166	Normal (0 +- 5845.00)
5	LIE_Contextuality	-349.29	[ -688.72, 18.94]	93.67%	66.47%	1.001	2201	Normal (0 +- 10890.12)
7	LIE_Negativity	9.28	[ -260.48, 293.86]	52.10%	98.40%	1.004	1246	Normal (0 +- 7742.93)
2	Age	71.32	[ 27.95, 117.46]	99.65%	100%	1.004	1885	Normal (0 +- 1573.27)
3	Education	484.19	[ 316.44, 636.12]	100%	33.58%	1.010	653	Normal (0 +- 5643.76)

model_profile %>%
  estimate_means() %>%
  mutate(LIE_Profile = fct_relevel(LIE_Profile, "Trickster", "Average", "Virtuous")) %>%
  ggplot(aes(x = LIE_Profile, y = Mean, color = LIE_Profile)) +
  geom_line(aes(group = 1), size = 1) +
  geom_pointrange(aes(ymin = CI_low, ymax = CI_high), size = 1) +
  theme_modern() +
  scale_color_manual(values = colors_cluster, guide = FALSE) +
  ylab("Income") +
  xlab("Deception Profile")

sig <- model_parameters(model_dimensional)[2:5,] %>%
  select(Parameter, pd) %>%
  mutate(Dimension = stringr::str_remove(Parameter, "LIE_"),
         Text = format_pd(pd, stars_only=TRUE),
         Predicted = 4500,
         Score = df %>%
           select(one_of(Parameter)) %>%
           summarise_all(function(x) {mean(range(x))}) %>%
           t()) %>%
  mutate(Dimension = fct_relevel(Dimension, "Ability", "Frequency", "Negativity", "Contextuality"))

p_income <- rbind(estimate_link(model_dimensional, target="LIE_Ability") %>%
        mutate(LIE_Frequency = NA, LIE_Contextuality=NA, LIE_Negativity=NA),
      estimate_link(model_dimensional, target="LIE_Frequency") %>%
        mutate(LIE_Ability = NA, LIE_Contextuality=NA, LIE_Negativity=NA),
      estimate_link(model_dimensional, target="LIE_Contextuality") %>%
        mutate(LIE_Frequency = NA, LIE_Ability=NA, LIE_Negativity=NA),
      estimate_link(model_dimensional, target="LIE_Negativity") %>%
        mutate(LIE_Frequency = NA, LIE_Contextuality=NA, LIE_Ability=NA)) %>%
  pivot_longer(cols=starts_with("LIE_"), names_to="Dimension", values_to = "Score") %>%
  mutate(Dimension = str_remove(Dimension, "LIE_"),
         Dimension = fct_relevel(Dimension, "Ability", "Frequency", "Negativity", "Contextuality")) %>%
  ggplot(aes(x = Score, y = Predicted)) +
  geom_ribbon(aes(ymin=CI_low, ymax=CI_high, fill=Dimension), alpha=0.1) +
  geom_line(aes(color=Dimension), size = 1) +
  geom_text(data = sig, aes(label = Text)) +
  theme_modern() +
  theme(strip.placement = "outside",
        strip.text = element_text(size=13, face="plain"),
        axis.title = element_text(size=13),
        axis.text = element_text(size=9),
        plot.title = element_text(face="bold", hjust = 0.5)) +
  ggtitle("Income") +
  ylab("Income (in SGD per capita)") +
  xlab("") +
  scale_color_manual(values=c("Ability"= "#2196F3", "Frequency"="#4CAF50", "Negativity"="#E91E63", "Contextuality"="#FF9800"), name = "Dimensions", guide=FALSE) +
   scale_fill_manual(values=c("Ability"= "#2196F3", "Frequency"="#4CAF50", "Negativity"="#E91E63", "Contextuality"="#FF9800"), name = "Dimensions", guide=FALSE) +
  facet_wrap(~Dimension, scales="free_x", strip.position = "bottom")

Religion

model_dimensional <- stan_lmer(Religion_Faith ~ LIE_Ability + LIE_Frequency + LIE_Contextuality + LIE_Negativity + (1|Religion_Type), data = dplyr::filter(df, !is.na(Religion_Faith)), refresh = 0, seed=333)
model_profile <- stan_lmer(Religion_Faith ~ LIE_Profile + (1|Religion_Type), data = dplyr::filter(df, !is.na(Religion_Faith)), refresh = 0, seed=333)

performance::compare_performance(model_dimensional, model_profile)

Model	Type	ELPD	ELPD_SE	LOOIC	LOOIC_SE	WAIC	R2	R2_marginal	R2_adjusted	RMSE
model_dimensional	stanreg	-1534	16	3068	33	3068	0.39	0.08	0.37	2.3
model_profile	stanreg	-1548	16	3097	32	3097	0.36	0.02	0.35	2.3

parameters::parameters_table(model_parameters(model_profile))

Parameter	Median	89% CI	pd	% in ROPE	Rhat	ESS	Prior
(Intercept)	4.40	[ 3.09, 5.68]	100%	0%	1.003	843	Normal (0 +- 29.28)
LIE_Profile [Trickster]	-0.38	[-0.68, -0.05]	97.15%	32.88%	1.001	3755	Normal (0 +- 7.32)
LIE_Profile [Virtuous]	0.47	[ 0.08, 0.86]	97.22%	22.55%	1.003	3302	Normal (0 +- 7.32)

parameters::parameters_table(model_parameters(model_dimensional))

	Parameter	Median	89% CI	pd	% in ROPE	Rhat	ESS	Prior
1	(Intercept)	4.32	[ 3.06, 5.40]	100%	0%	1.001	1168	Normal (0 +- 29.28)
2	LIE_Ability	0.00	[-0.07, 0.09]	53.65%	100%	1.002	3441	Normal (0 +- 3.12)
4	LIE_Frequency	0.20	[ 0.10, 0.30]	99.78%	93.33%	1.000	3197	Normal (0 +- 3.95)
3	LIE_Contextuality	-0.38	[-0.58, -0.20]	99.90%	23.10%	1.002	3356	Normal (0 +- 7.27)
5	LIE_Negativity	0.36	[ 0.21, 0.52]	99.98%	23.08%	1.000	3081	Normal (0 +- 5.22)

model_profile %>%
  estimate_means() %>%
  mutate(LIE_Profile = fct_relevel(LIE_Profile, "Trickster", "Average", "Virtuous")) %>%
  ggplot(aes(x = LIE_Profile, y = Mean, color = LIE_Profile)) +
  geom_line(aes(group = 1), size = 1) +
  geom_pointrange(aes(ymin = CI_low, ymax = CI_high), size = 1) +
  theme_modern() +
  scale_color_manual(values = colors_cluster, guide = FALSE) +
  ylab("Faith") +
  xlab("Deception Profile")

sig <- model_parameters(model_dimensional)[-1,] %>%
  select(Parameter, pd) %>%
  mutate(Dimension = stringr::str_remove(Parameter, "LIE_"),
         Text = format_pd(pd, stars_only=TRUE),
         Predicted = 6.5,
         Score = dplyr::filter(df, !is.na(Religion_Faith)) %>%
           select(one_of(Parameter)) %>%
           summarise_all(function(x) {mean(range(x))}) %>%
           t()) %>%
  mutate(Dimension = fct_relevel(Dimension, "Ability", "Frequency", "Negativity", "Contextuality"))


p_religion <- rbind(estimate_link(model_dimensional, target="LIE_Ability") %>%
        mutate(LIE_Frequency = NA, LIE_Contextuality=NA, LIE_Negativity=NA),
      estimate_link(model_dimensional, target="LIE_Frequency") %>%
        mutate(LIE_Ability = NA, LIE_Contextuality=NA, LIE_Negativity=NA),
      estimate_link(model_dimensional, target="LIE_Contextuality") %>%
        mutate(LIE_Frequency = NA, LIE_Ability=NA, LIE_Negativity=NA),
      estimate_link(model_dimensional, target="LIE_Negativity") %>%
        mutate(LIE_Frequency = NA, LIE_Contextuality=NA, LIE_Ability=NA)) %>%
  pivot_longer(cols=starts_with("LIE_"), names_to="Dimension", values_to = "Score") %>%
  mutate(Dimension = str_remove(Dimension, "LIE_"),
         Dimension = fct_relevel(Dimension, "Ability", "Frequency", "Negativity", "Contextuality")) %>%
  ggplot(aes(x = Score, y = Predicted)) +
  geom_ribbon(aes(ymin=CI_low, ymax=CI_high, fill=Dimension), alpha=0.1) +
  geom_line(aes(color=Dimension), size = 1) +
  theme_modern() +
  theme(strip.placement = "outside",
        strip.text = element_text(size=13, face="plain"),
        axis.title = element_text(size=13),
        axis.text = element_text(size=9),
        plot.title = element_text(face="bold", hjust = 0.5)) +
  geom_text(data = sig, aes(label = Text)) +
  ggtitle("Religion") +
  ylab("\nFaith") +
  xlab("") +
  scale_color_manual(values=c("Ability"= "#2196F3", "Frequency"="#4CAF50", "Negativity"="#E91E63", "Contextuality"="#FF9800"), name = "Dimensions", guide=FALSE) +
   scale_fill_manual(values=c("Ability"= "#2196F3", "Frequency"="#4CAF50", "Negativity"="#E91E63", "Contextuality"="#FF9800"), name = "Dimensions", guide=FALSE) +
  facet_wrap(~Dimension, scales="free_x", strip.position = "bottom")

# Combine plots
cowplot::plot_grid(p_sex, p_age, p_income, p_religion, nrow=2)

# ggsave("60-40-datasplit/demographics.png", combine_plots, height=figwidth, width=figwidth)

Number of Lies

Raw

df$Lying_Frequency <- (df$Lying_Frequency_Day + df$Lying_Frequency_Week / 7) / 2
outliers <- check_outliers(df$Lying_Frequency, method = "zscore", threshold = list("zscore" = stats::qnorm(p = 0.999)))
df$Lying_Frequency[outliers == 1] <- NA


p_freq1 <- df %>%
  filter(!is.na(Lying_Frequency)) %>%
  ggplot(aes(x = Lying_Frequency)) +
  geom_histogram(aes(y=..density.., fill = ..x..), binwidth = 1/7) +
  geom_line(data=estimate_density(df$Lying_Frequency, method = "kernSmooth"),
            aes(x = x, y = y), color = "#2196F3", size = 1.5) +
  scale_fill_gradient(low='#AD1457', high='#F48FB1', guide = FALSE) +
  ylab("Distribution of Participants") +
  xlab(expression(paste('Lying Frequency ', italic("(lies / day)"))))  +
  theme_modern() +
  theme(axis.text.y = element_blank())

library(ggforce)

df %>%
  filter(!is.na(Lying_Frequency)) %>%
  dplyr::select(starts_with("LIE"), Lying_Frequency) %>%
  ggplot(aes(x = .panel_x, y = .panel_y, fill = LIE_Profile, colour = LIE_Profile)) +
  geom_point(alpha = 1, shape = 16, size = 0.5) +
  geom_smooth(method = 'lm', formula = y ~ poly(x, 1), alpha = 0.1) +
  scale_color_manual(values = colors_cluster) +
  scale_fill_manual(values = colors_cluster) +
  ggforce::facet_matrix(cols = vars(LIE_Ability , LIE_Frequency, LIE_Negativity, LIE_Contextuality), rows = vars(Lying_Frequency)) +
  coord_cartesian(ylim = c(0, 5)) +
  theme_modern()

model_profile <- stan_glm(Lying_Frequency ~ LIE_Profile, data = df, refresh = 0, seed=333)
model_dimensional <- stan_glm(Lying_Frequency ~ LIE_Ability + LIE_Frequency + LIE_Contextuality + LIE_Negativity, data = df, refresh = 0, seed=333)

performance::compare_performance(model_dimensional, model_profile)

Model	Type	ELPD	ELPD_SE	LOOIC	LOOIC_SE	WAIC	R2	R2_adjusted	RMSE
model_dimensional	stanreg	-832	21	1664	41	1664	0.13	0.11	0.85
model_profile	stanreg	-839	20	1678	40	1678	0.10	0.09	0.86

parameters::parameters_table(model_parameters(model_profile))

Parameter	Median	89% CI	pd	% in ROPE	Rhat	ESS	Prior
(Intercept)	1.13	[ 1.04, 1.21]	100%	0%	1.000	4028	Normal (0 +- 9.09)
LIE_Profile [Trickster]	0.37	[ 0.25, 0.50]	100%	0.02%	0.999	4112	Normal (0 +- 2.27)
LIE_Profile [Virtuous]	-0.41	[-0.55, -0.27]	100%	0.05%	1.000	4117	Normal (0 +- 2.27)

parameters::parameters_table(model_parameters(model_dimensional))

	Parameter	Median	89% CI	pd	% in ROPE	Rhat	ESS	Prior
1	(Intercept)	1.18	[ 1.13, 1.24]	100%	0%	1.000	3696	Normal (0 +- 9.09)
2	LIE_Ability	0.02	[-0.01, 0.05]	90.53%	99.95%	1.001	3571	Normal (0 +- 0.96)
4	LIE_Frequency	0.12	[ 0.09, 0.16]	100%	9.72%	1.001	3597	Normal (0 +- 1.25)
3	LIE_Contextuality	0.05	[-0.01, 0.12]	88.52%	83.30%	1.000	3678	Normal (0 +- 2.26)
5	LIE_Negativity	-0.04	[-0.10, 0.01]	89.18%	92.42%	1.001	3211	Normal (0 +- 1.66)

p_freq2 <- model_dimensional %>%
  estimate_link(target = "LIE_Frequency", length = 10, smooth_strength = 0) %>%
  ggplot(aes(x = LIE_Frequency, y = Predicted)) +
  geom_point2(data = df, aes(y = Lying_Frequency, color = Lying_Frequency), size = 4, alpha=0.7) +
  geom_ribbon(aes(ymin = CI_low, ymax = CI_high), alpha = 0.2) +
  geom_line(size = 1.5) +
  scale_color_gradient(low='#AD1457', high='#F48FB1', guide = FALSE) +
  theme_modern() +
  ylab("Absolute Lying Frequency (lies / day)") +
  xlab("LIE - Frequency") +
  theme(plot.margin = unit(c(5.5, 0, 5.5, 5.5), "pt"))

# Combine plots
cowplot::plot_grid(p_freq2,
                   p_freq1 +
                     coord_flip() +
                     xlab("") +
                     ylab("") +
                     theme(axis.line = element_blank(),
                           axis.text.x = element_blank(),
                           axis.title.y = element_blank(),
                           axis.line.y = element_blank(),
                           axis.ticks.y=element_blank(),
                           plot.margin = unit(c(0, 0, 10, -20), "pt")),
                   nrow=1, rel_widths = c(0.75, 0.25))

Adjusted

df$Lying_Frequency_Adjusted <- effectsize::adjust(df, select = "Lying_Frequency", effect = c("BIDR_ImpressionManagement", "BIDR_SelfDeceptiveEnhancement"))$Lying_Frequency
df$Lying_Frequency_Adjusted <- df$Lying_Frequency_Adjusted + abs(min(df$Lying_Frequency_Adjusted, na.rm=TRUE))


p_freq1adj <- df %>%
  filter(!is.na(Lying_Frequency_Adjusted)) %>%
  ggplot(aes(x = Lying_Frequency_Adjusted)) +
  geom_histogram(aes(y=..density.., fill = ..x..), binwidth = 1/7) +
  geom_line(data=estimate_density(df$Lying_Frequency_Adjusted, method = "kernSmooth"),
            aes(x = x, y = y), color = "red", size = 1.5) +
  scale_fill_gradient(low='#1A237E', high='#2196F3', guide = FALSE) +
  ylab("Distribution of Participants") +
  xlab(expression(paste('Lying Frequency ', italic("(lies / day)"))))  +
  theme_modern() +
  theme(axis.text.y = element_blank())

library(ggforce)

df %>%
  filter(!is.na(Lying_Frequency_Adjusted)) %>%
  dplyr::select(starts_with("LIE"), Lying_Frequency_Adjusted) %>%
  ggplot(aes(x = .panel_x, y = .panel_y, fill = LIE_Profile, colour = LIE_Profile)) +
  geom_point(alpha = 1, shape = 16, size = 0.5) +
  geom_smooth(method = 'lm', formula = y ~ poly(x, 1), alpha = 0.1) +
  scale_color_manual(values = colors_cluster) +
  scale_fill_manual(values = colors_cluster) +
  ggforce::facet_matrix(cols = vars(LIE_Ability , LIE_Frequency, LIE_Negativity, LIE_Contextuality), rows = vars(Lying_Frequency_Adjusted)) +
  coord_cartesian(ylim = c(0, 5)) +
  theme_modern()

model_profile <- stan_glm(Lying_Frequency_Adjusted ~ LIE_Profile, data = df, refresh = 0, seed=333)
model_dimensional <- stan_glm(Lying_Frequency_Adjusted ~ LIE_Ability + LIE_Frequency + LIE_Contextuality + LIE_Negativity, data = df, refresh = 0, seed=333)

performance::compare_performance(model_dimensional, model_profile)

Model	Type	ELPD	ELPD_SE	LOOIC	LOOIC_SE	WAIC	R2	R2_adjusted	RMSE
model_dimensional	stanreg	-837	20	1675	41	1675	0.08	0.06	0.86
model_profile	stanreg	-839	20	1678	40	1678	0.07	0.06	0.86

parameters::parameters_table(model_parameters(model_profile))

Parameter	Median	89% CI	pd	% in ROPE	Rhat	ESS	Prior
(Intercept)	1.43	[ 1.35, 1.51]	100%	0%	1.000	3883	Normal (0 +- 8.93)
LIE_Profile [Trickster]	0.29	[ 0.17, 0.41]	100%	0.50%	1.000	4111	Normal (0 +- 2.23)
LIE_Profile [Virtuous]	-0.34	[-0.48, -0.20]	100%	0.12%	1.000	4081	Normal (0 +- 2.23)

parameters::parameters_table(model_parameters(model_dimensional))

	Parameter	Median	89% CI	pd	% in ROPE	Rhat	ESS	Prior
1	(Intercept)	1.47	[ 1.41, 1.52]	100%	0%	1.000	3402	Normal (0 +- 8.93)
2	LIE_Ability	0.03	[ 0.00, 0.06]	95.58%	99.88%	1.000	3159	Normal (0 +- 0.95)
4	LIE_Frequency	0.10	[ 0.06, 0.13]	100%	38.15%	1.000	3251	Normal (0 +- 1.23)
3	LIE_Contextuality	0.00	[-0.06, 0.07]	55.15%	96.25%	1.000	3780	Normal (0 +- 2.22)
5	LIE_Negativity	-0.03	[-0.08, 0.03]	77.20%	95.83%	0.999	3120	Normal (0 +- 1.63)

p_freq2adj <- model_dimensional %>%
  estimate_link(target = "LIE_Frequency", length = 10, smooth_strength = 0) %>%
  ggplot(aes(x = LIE_Frequency, y = Predicted)) +
  geom_point2(data = df, aes(y = Lying_Frequency_Adjusted, color = Lying_Frequency_Adjusted), size = 4, alpha=0.7) +
  geom_ribbon(aes(ymin = CI_low, ymax = CI_high), alpha = 0.2) +
  geom_line(size = 1.5) +
  scale_color_gradient(low='#1A237E', high='#2196F3', guide = FALSE) +
  theme_modern() +
  ylab("Absolute Lying Frequency (lies / day)") +
  xlab("LIE - Frequency") +
  theme(plot.margin = unit(c(5.5, 0, 5.5, 5.5), "pt"))

# Combine plots
cowplot::plot_grid(p_freq2adj,
                   p_freq1adj +
                     coord_flip() +
                     xlab("") +
                     ylab("") +
                     theme(axis.line = element_blank(),
                           axis.text.x = element_blank(),
                           axis.title.y = element_blank(),
                           axis.line.y = element_blank(),
                           axis.ticks.y=element_blank(),
                           plot.margin = unit(c(0, 0, 10, -20), "pt")),
                   nrow=1, rel_widths = c(0.75, 0.25))

Social Desirability (BIDR)

Utility Functions

library(ggraph)
library(tidygraph)

colors_nodes <- c("LIE"= "#9C27B0",
                  "Psychopathy" = "#f44336",
                  "Narcissism" = "#FF9800",
                  "Pathological Personality" = "#FFC107",
                  "Normal Personality" = "#4CAF50",
                  "Social Desirability" = "#795548",
                  "Light Triad" = "#2196F3",
                  "Impulsivity" = "#673AB7",
                  "Emotion Regulation" = "#E91E63",
                  "Interoception" = "#b71c1c")

# convenience function
create_ggm <- function(data, title = "Pychopathy (TRIMP)", title_size=22, label_edges = TRUE, node_size=32, text_size=5.5, layout="kk", seed=333, bend=0.2){
  set.seed(seed)

  label_edges <- ifelse(rep_len(label_edges, length.out=nrow(data$edges)), insight::format_value(data$edges$r), "")

  data %>%
    ggraph(layout = layout) +
    geom_edge_arc(aes(colour=r, edge_width = abs(r), label = label_edges),
                  strength=bend,
                  angle_calc = 'along',
                  label_dodge = unit(3.5, 'mm'),
                  check_overlap = FALSE) +
    geom_node_point(aes(colour = Questionnaire), size=node_size) +
    geom_node_text(aes(label = name), colour="white", check_overlap = FALSE, repel = FALSE, size=text_size, fontface="bold") +
    scale_edge_color_gradient2(low = "#d50000", high = "#00C853") +
    scale_color_manual(values = colors_nodes) +
    theme_graph() +
    guides(edge_width = FALSE,
           edge_color = FALSE,
           colour = FALSE) +
    scale_x_continuous(expand = expansion(c(.15, .15))) +
    scale_y_continuous(expand = expansion(c(.15, .15))) +
    theme(plot.title = element_text(hjust = 0.5, face="bold", size = title_size),
          plot.margin = unit(c(0, 0, 0, 0), "cm")) +
    ggtitle(title)
}

Gaussian Graphical Model

cor_bidr <- correlation::correlation(
  dplyr::select(df, dplyr::starts_with("LIE"), dplyr::starts_with("BIDR"), -BIDR_General),
  partial = TRUE, p_adjust = "none")

parameters::parameters_table(cor_bidr)

Parameter1	Parameter2	r	95% CI	t	df	p	Method	n_Obs
LIE_Ability	LIE_Frequency	0.24	[ 0.17, 0.31]	6.68	714	< .001	Pearson	716
LIE_Ability	LIE_Negativity	-0.19	[-0.26, -0.12]	-5.12	714	< .001	Pearson	716
LIE_Ability	LIE_Contextuality	0.38	[ 0.31, 0.44]	10.93	714	< .001	Pearson	716
LIE_Ability	BIDR_SelfDeceptiveEnhancement	0.22	[ 0.15, 0.29]	6.17	714	< .001	Pearson	716
LIE_Ability	BIDR_ImpressionManagement	-0.06	[-0.13, 0.01]	-1.63	714	0.103	Pearson	716
LIE_Frequency	LIE_Negativity	-0.47	[-0.53, -0.41]	-14.34	714	< .001	Pearson	716
LIE_Frequency	LIE_Contextuality	-0.13	[-0.20, -0.06]	-3.55	714	< .001	Pearson	716
LIE_Frequency	BIDR_SelfDeceptiveEnhancement	-0.21	[-0.28, -0.14]	-5.80	714	< .001	Pearson	716
LIE_Frequency	BIDR_ImpressionManagement	-0.12	[-0.19, -0.05]	-3.22	714	0.001	Pearson	716
LIE_Negativity	LIE_Contextuality	-0.29	[-0.36, -0.22]	-8.17	714	< .001	Pearson	716
LIE_Negativity	BIDR_SelfDeceptiveEnhancement	-0.07	[-0.14, 0.00]	-1.89	714	0.059	Pearson	716
LIE_Negativity	BIDR_ImpressionManagement	0.13	[ 0.06, 0.20]	3.57	714	< .001	Pearson	716
LIE_Contextuality	BIDR_SelfDeceptiveEnhancement	-0.12	[-0.19, -0.05]	-3.26	714	0.001	Pearson	716
LIE_Contextuality	BIDR_ImpressionManagement	-0.17	[-0.24, -0.10]	-4.54	714	< .001	Pearson	716
BIDR_SelfDeceptiveEnhancement	BIDR_ImpressionManagement	0.24	[ 0.17, 0.31]	6.74	714	< .001	Pearson	716

graphdata_bidr <- cor_bidr %>%
  filter(p < .001) %>%
  tidygraph::as_tbl_graph() %>%
  as.list()

graphdata_bidr$nodes$Questionnaire <- ifelse(stringr::str_detect(graphdata_bidr$nodes$name, "LIE_"),
                               "LIE", "Social Desirability")
graphdata_bidr$nodes$name <- stringr::str_remove(graphdata_bidr$nodes$name, "LIE_|BIDR_")
graphdata_bidr$nodes$name <- stringr::str_replace(graphdata_bidr$nodes$name, "fD", "f-D")
graphdata_bidr$nodes$name <- stringr::str_replace(graphdata_bidr$nodes$name, "nM", "n\nM")
graphdata_bidr$nodes$name <- stringr::str_replace(graphdata_bidr$nodes$name, "eE", "e\nE")

ggm_bidr <- create_ggm(graphdata_bidr, title = "Social Desirability", layout="sugiyama")
ggm_bidr

After controlling for social desirability, it seems that the relationship between frequency and contextuality changed from being positive to negative. The more people lie (likely representing a lack of control), and the less flexible and insensitive to the context they are.

Adjust for Social Desirability

lie <- df[names(dplyr::select(df, dplyr::starts_with("LIE"), -LIE_Profile))]
df[names(lie)] <- effectsize::adjust(data = cbind(lie, df[c("BIDR_ImpressionManagement", "BIDR_SelfDeceptiveEnhancement", "Age", "Sex")]),
                                     effect = c("BIDR_ImpressionManagement", "BIDR_SelfDeceptiveEnhancement", "Age", "Sex"),
                                     multilevel = TRUE)[names(lie)]

Psychopathy (TRIMP)

cor_trimp <- correlation::correlation(
  dplyr::select(df, dplyr::starts_with("LIE"), -LIE_Profile, TRIMP_Boldness, TRIMP_Meanness, TRIMP_Disinhibition),
  partial = TRUE, p_adjust = "none")

parameters::parameters_table(cor_trimp)

Parameter1	Parameter2	r	95% CI	t	df	p	Method	n_Obs
LIE_Ability	LIE_Frequency	0.21	[ 0.14, 0.28]	5.85	708	< .001	Pearson	710
LIE_Ability	LIE_Negativity	-0.17	[-0.24, -0.10]	-4.68	708	< .001	Pearson	710
LIE_Ability	LIE_Contextuality	0.39	[ 0.32, 0.45]	11.17	708	< .001	Pearson	710
LIE_Ability	TRIMP_Boldness	0.26	[ 0.19, 0.33]	7.21	708	< .001	Pearson	710
LIE_Ability	TRIMP_Meanness	-0.03	[-0.11, 0.04]	-0.89	708	0.372	Pearson	710
LIE_Ability	TRIMP_Disinhibition	0.07	[ 0.00, 0.14]	1.86	708	0.063	Pearson	710
LIE_Frequency	LIE_Negativity	-0.46	[-0.52, -0.40]	-13.93	708	< .001	Pearson	710
LIE_Frequency	LIE_Contextuality	-0.11	[-0.18, -0.04]	-2.91	708	0.004	Pearson	710
LIE_Frequency	TRIMP_Boldness	0.02	[-0.05, 0.09]	0.52	708	0.602	Pearson	710
LIE_Frequency	TRIMP_Meanness	0.01	[-0.06, 0.09]	0.36	708	0.722	Pearson	710
LIE_Frequency	TRIMP_Disinhibition	0.24	[ 0.17, 0.30]	6.46	708	< .001	Pearson	710
LIE_Negativity	LIE_Contextuality	-0.29	[-0.35, -0.22]	-7.92	708	< .001	Pearson	710
LIE_Negativity	TRIMP_Boldness	0.04	[-0.03, 0.12]	1.17	708	0.241	Pearson	710
LIE_Negativity	TRIMP_Meanness	-0.18	[-0.25, -0.11]	-4.97	708	< .001	Pearson	710
LIE_Negativity	TRIMP_Disinhibition	0.18	[ 0.10, 0.25]	4.77	708	< .001	Pearson	710
LIE_Contextuality	TRIMP_Boldness	-0.10	[-0.17, -0.02]	-2.62	708	0.009	Pearson	710
LIE_Contextuality	TRIMP_Meanness	-0.03	[-0.10, 0.05]	-0.68	708	0.494	Pearson	710
LIE_Contextuality	TRIMP_Disinhibition	-0.01	[-0.09, 0.06]	-0.36	708	0.720	Pearson	710
TRIMP_Boldness	TRIMP_Meanness	0.27	[ 0.20, 0.34]	7.59	708	< .001	Pearson	710
TRIMP_Boldness	TRIMP_Disinhibition	-0.29	[-0.36, -0.22]	-8.09	708	< .001	Pearson	710
TRIMP_Meanness	TRIMP_Disinhibition	0.61	[ 0.56, 0.65]	20.35	708	< .001	Pearson	710

graphdata_trimp <- cor_trimp %>%
  filter(p < .001) %>%
  tidygraph::as_tbl_graph() %>%
  as.list()

graphdata_trimp$nodes$Questionnaire <- ifelse(stringr::str_detect(graphdata_trimp$nodes$name, "LIE_"),
                               "LIE", "Psychopathy")
graphdata_trimp$nodes$name <- stringr::str_remove(graphdata_trimp$nodes$name, "LIE_|TRIMP_")


create_ggm(graphdata_trimp, title = "Pychopathy")

Narcissism (FFNI)

cor_ffni <- correlation::correlation(
  dplyr::select(df, dplyr::starts_with("LIE"), dplyr::starts_with("FFNI"), -FFNI_General),
  partial = TRUE, p_adjust = "none")

parameters::parameters_table(cor_ffni)

Parameter1	Parameter2	r	95% CI	t	df	p	Method	n_Obs
LIE_Ability	LIE_Frequency	0.21	[ 0.14, 0.28]	5.83	708	< .001	Pearson	710
LIE_Ability	LIE_Negativity	-0.20	[-0.27, -0.13]	-5.51	708	< .001	Pearson	710
LIE_Ability	LIE_Contextuality	0.35	[ 0.29, 0.41]	9.99	708	< .001	Pearson	710
LIE_Ability	FFNI_AcclaimSeeking	0.02	[-0.06, 0.09]	0.46	708	0.648	Pearson	710
LIE_Ability	FFNI_Distrust	0.06	[-0.01, 0.13]	1.61	708	0.107	Pearson	710
LIE_Ability	FFNI_Entitlement	-0.06	[-0.14, 0.01]	-1.66	708	0.098	Pearson	710
LIE_Ability	FFNI_Exploitativeness	-0.15	[-0.22, -0.08]	-4.14	708	< .001	Pearson	710
LIE_Ability	FFNI_Indifference	0.00	[-0.07, 0.08]	0.10	708	0.923	Pearson	710
LIE_Ability	FFNI_LackOfEmpathy	-0.02	[-0.09, 0.06]	-0.42	708	0.677	Pearson	710
LIE_Ability	FFNI_Manipulativeness	0.37	[ 0.31, 0.44]	10.74	708	< .001	Pearson	710
LIE_Ability	FFNI_NeedForAdmiration	0.03	[-0.04, 0.10]	0.82	708	0.411	Pearson	710
LIE_Ability	FFNI_ThrillSeeking	0.03	[-0.05, 0.10]	0.76	708	0.446	Pearson	710
LIE_Frequency	LIE_Negativity	-0.46	[-0.51, -0.40]	-13.73	708	< .001	Pearson	710
LIE_Frequency	LIE_Contextuality	-0.13	[-0.20, -0.05]	-3.42	708	< .001	Pearson	710
LIE_Frequency	FFNI_AcclaimSeeking	-0.01	[-0.08, 0.07]	-0.16	708	0.876	Pearson	710
LIE_Frequency	FFNI_Distrust	0.00	[-0.08, 0.07]	-0.11	708	0.916	Pearson	710
LIE_Frequency	FFNI_Entitlement	0.08	[ 0.01, 0.15]	2.15	708	0.032	Pearson	710
LIE_Frequency	FFNI_Exploitativeness	0.02	[-0.05, 0.10]	0.63	708	0.526	Pearson	710
LIE_Frequency	FFNI_Indifference	0.02	[-0.05, 0.10]	0.65	708	0.516	Pearson	710
LIE_Frequency	FFNI_LackOfEmpathy	0.14	[ 0.07, 0.21]	3.77	708	< .001	Pearson	710
LIE_Frequency	FFNI_Manipulativeness	-0.03	[-0.10, 0.05]	-0.70	708	0.486	Pearson	710
LIE_Frequency	FFNI_NeedForAdmiration	0.06	[-0.02, 0.13]	1.50	708	0.133	Pearson	710
LIE_Frequency	FFNI_ThrillSeeking	0.08	[ 0.00, 0.15]	2.08	708	0.038	Pearson	710
LIE_Negativity	LIE_Contextuality	-0.29	[-0.36, -0.22]	-8.05	708	< .001	Pearson	710
LIE_Negativity	FFNI_AcclaimSeeking	0.12	[ 0.05, 0.19]	3.28	708	0.001	Pearson	710
LIE_Negativity	FFNI_Distrust	0.01	[-0.06, 0.09]	0.33	708	0.743	Pearson	710
LIE_Negativity	FFNI_Entitlement	0.03	[-0.04, 0.11]	0.93	708	0.353	Pearson	710
LIE_Negativity	FFNI_Exploitativeness	-0.11	[-0.18, -0.04]	-2.95	708	0.003	Pearson	710
LIE_Negativity	FFNI_Indifference	0.00	[-0.07, 0.08]	0.10	708	0.924	Pearson	710
LIE_Negativity	FFNI_LackOfEmpathy	0.03	[-0.04, 0.11]	0.88	708	0.379	Pearson	710
LIE_Negativity	FFNI_Manipulativeness	0.07	[ 0.00, 0.14]	1.83	708	0.067	Pearson	710
LIE_Negativity	FFNI_NeedForAdmiration	0.10	[ 0.03, 0.17]	2.64	708	0.009	Pearson	710
LIE_Negativity	FFNI_ThrillSeeking	0.01	[-0.06, 0.09]	0.35	708	0.730	Pearson	710
LIE_Contextuality	FFNI_AcclaimSeeking	0.05	[-0.02, 0.12]	1.36	708	0.175	Pearson	710
LIE_Contextuality	FFNI_Distrust	-0.01	[-0.08, 0.06]	-0.28	708	0.780	Pearson	710
LIE_Contextuality	FFNI_Entitlement	-0.03	[-0.10, 0.05]	-0.71	708	0.475	Pearson	710
LIE_Contextuality	FFNI_Exploitativeness	0.04	[-0.04, 0.11]	0.94	708	0.346	Pearson	710
LIE_Contextuality	FFNI_Indifference	0.06	[-0.02, 0.13]	1.50	708	0.134	Pearson	710
LIE_Contextuality	FFNI_LackOfEmpathy	-0.01	[-0.08, 0.06]	-0.29	708	0.769	Pearson	710
LIE_Contextuality	FFNI_Manipulativeness	-0.06	[-0.13, 0.01]	-1.61	708	0.109	Pearson	710
LIE_Contextuality	FFNI_NeedForAdmiration	0.10	[ 0.03, 0.17]	2.64	708	0.009	Pearson	710
LIE_Contextuality	FFNI_ThrillSeeking	0.02	[-0.06, 0.09]	0.44	708	0.659	Pearson	710
FFNI_AcclaimSeeking	FFNI_Distrust	0.04	[-0.04, 0.11]	0.96	708	0.335	Pearson	710
FFNI_AcclaimSeeking	FFNI_Entitlement	0.17	[ 0.10, 0.24]	4.60	708	< .001	Pearson	710
FFNI_AcclaimSeeking	FFNI_Exploitativeness	-0.02	[-0.09, 0.06]	-0.43	708	0.666	Pearson	710
FFNI_AcclaimSeeking	FFNI_Indifference	0.02	[-0.05, 0.10]	0.62	708	0.539	Pearson	710
FFNI_AcclaimSeeking	FFNI_LackOfEmpathy	-0.16	[-0.23, -0.09]	-4.27	708	< .001	Pearson	710
FFNI_AcclaimSeeking	FFNI_Manipulativeness	0.23	[ 0.15, 0.29]	6.15	708	< .001	Pearson	710
FFNI_AcclaimSeeking	FFNI_NeedForAdmiration	-0.09	[-0.16, -0.02]	-2.45	708	0.015	Pearson	710
FFNI_AcclaimSeeking	FFNI_ThrillSeeking	0.17	[ 0.09, 0.24]	4.50	708	< .001	Pearson	710
FFNI_Distrust	FFNI_Entitlement	0.07	[-0.01, 0.14]	1.78	708	0.076	Pearson	710
FFNI_Distrust	FFNI_Exploitativeness	0.17	[ 0.10, 0.24]	4.68	708	< .001	Pearson	710
FFNI_Distrust	FFNI_Indifference	0.11	[ 0.04, 0.18]	2.93	708	0.003	Pearson	710
FFNI_Distrust	FFNI_LackOfEmpathy	0.05	[-0.02, 0.13]	1.44	708	0.152	Pearson	710
FFNI_Distrust	FFNI_Manipulativeness	-0.02	[-0.10, 0.05]	-0.65	708	0.518	Pearson	710
FFNI_Distrust	FFNI_NeedForAdmiration	0.17	[ 0.10, 0.24]	4.53	708	< .001	Pearson	710
FFNI_Distrust	FFNI_ThrillSeeking	-0.05	[-0.13, 0.02]	-1.40	708	0.163	Pearson	710
FFNI_Entitlement	FFNI_Exploitativeness	0.28	[ 0.21, 0.34]	7.65	708	< .001	Pearson	710
FFNI_Entitlement	FFNI_Indifference	-0.04	[-0.12, 0.03]	-1.13	708	0.257	Pearson	710
FFNI_Entitlement	FFNI_LackOfEmpathy	0.25	[ 0.18, 0.32]	6.79	708	< .001	Pearson	710
FFNI_Entitlement	FFNI_Manipulativeness	0.07	[ 0.00, 0.15]	1.93	708	0.054	Pearson	710
FFNI_Entitlement	FFNI_NeedForAdmiration	0.11	[ 0.04, 0.18]	3.00	708	0.003	Pearson	710
FFNI_Entitlement	FFNI_ThrillSeeking	0.09	[ 0.02, 0.16]	2.39	708	0.017	Pearson	710
FFNI_Exploitativeness	FFNI_Indifference	-0.02	[-0.10, 0.05]	-0.61	708	0.541	Pearson	710
FFNI_Exploitativeness	FFNI_LackOfEmpathy	0.23	[ 0.16, 0.30]	6.34	708	< .001	Pearson	710
FFNI_Exploitativeness	FFNI_Manipulativeness	0.41	[ 0.35, 0.47]	11.94	708	< .001	Pearson	710
FFNI_Exploitativeness	FFNI_NeedForAdmiration	0.10	[ 0.03, 0.17]	2.68	708	0.007	Pearson	710
FFNI_Exploitativeness	FFNI_ThrillSeeking	0.05	[-0.02, 0.13]	1.40	708	0.163	Pearson	710
FFNI_Indifference	FFNI_LackOfEmpathy	0.31	[ 0.25, 0.38]	8.77	708	< .001	Pearson	710
FFNI_Indifference	FFNI_Manipulativeness	0.14	[ 0.07, 0.21]	3.86	708	< .001	Pearson	710
FFNI_Indifference	FFNI_NeedForAdmiration	-0.49	[-0.54, -0.43]	-14.77	708	< .001	Pearson	710
FFNI_Indifference	FFNI_ThrillSeeking	0.20	[ 0.13, 0.27]	5.48	708	< .001	Pearson	710
FFNI_LackOfEmpathy	FFNI_Manipulativeness	-0.04	[-0.11, 0.03]	-1.06	708	0.288	Pearson	710
FFNI_LackOfEmpathy	FFNI_NeedForAdmiration	0.01	[-0.06, 0.09]	0.38	708	0.700	Pearson	710
FFNI_LackOfEmpathy	FFNI_ThrillSeeking	0.07	[ 0.00, 0.14]	1.91	708	0.057	Pearson	710
FFNI_Manipulativeness	FFNI_NeedForAdmiration	-0.02	[-0.10, 0.05]	-0.65	708	0.516	Pearson	710
FFNI_Manipulativeness	FFNI_ThrillSeeking	0.09	[ 0.01, 0.16]	2.28	708	0.023	Pearson	710
FFNI_NeedForAdmiration	FFNI_ThrillSeeking	0.09	[ 0.01, 0.16]	2.36	708	0.019	Pearson	710

graphdata_ffni <- cor_ffni %>%
  filter(p < .001) %>%
  tidygraph::as_tbl_graph() %>%
  as.list()

graphdata_ffni$nodes$Questionnaire <- ifelse(stringr::str_detect(graphdata_ffni$nodes$name, "LIE_"),
                               "LIE", "Narcissism")
graphdata_ffni$nodes$name <- stringr::str_remove(graphdata_ffni$nodes$name, "LIE_|FFNI_")
graphdata_ffni$nodes$name <- stringr::str_replace(graphdata_ffni$nodes$name, "dForA", "d for\nA")
graphdata_ffni$nodes$name <- stringr::str_replace(graphdata_ffni$nodes$name, "mS", "m\nS")
graphdata_ffni$nodes$name <- stringr::str_replace(graphdata_ffni$nodes$name, "lS", "l\nS")
graphdata_ffni$nodes$name <- stringr::str_replace(graphdata_ffni$nodes$name, "kOfE", "k of\nE")


ggm_ffni <- create_ggm(graphdata_ffni, title = "Narcissism", node_size=38)
ggm_ffni

Normal Personality (IPIP6)

cor_ipip <- correlation::correlation(
  dplyr::select(df, dplyr::starts_with("LIE"), dplyr::starts_with("IPIP6")),
  partial = TRUE, p_adjust = "none")

parameters::parameters_table(cor_ipip)

Parameter1	Parameter2	r	95% CI	t	df	p	Method	n_Obs
LIE_Ability	LIE_Frequency	0.24	[ 0.17, 0.31]	6.69	708	< .001	Pearson	710
LIE_Ability	LIE_Negativity	-0.17	[-0.24, -0.09]	-4.48	708	< .001	Pearson	710
LIE_Ability	LIE_Contextuality	0.37	[ 0.31, 0.44]	10.76	708	< .001	Pearson	710
LIE_Ability	IPIP6_Extraversion	0.12	[ 0.04, 0.19]	3.10	708	0.002	Pearson	710
LIE_Ability	IPIP6_Agreableness	0.01	[-0.07, 0.08]	0.18	708	0.857	Pearson	710
LIE_Ability	IPIP6_Conscientiousness	0.00	[-0.07, 0.08]	0.06	708	0.949	Pearson	710
LIE_Ability	IPIP6_Neuroticism	-0.02	[-0.10, 0.05]	-0.63	708	0.528	Pearson	710
LIE_Ability	IPIP6_Openeness	0.19	[ 0.11, 0.26]	5.04	708	< .001	Pearson	710
LIE_Ability	IPIP6_HonestyHumility	-0.04	[-0.11, 0.03]	-1.05	708	0.292	Pearson	710
LIE_Frequency	LIE_Negativity	-0.45	[-0.51, -0.39]	-13.55	708	< .001	Pearson	710
LIE_Frequency	LIE_Contextuality	-0.12	[-0.19, -0.04]	-3.09	708	0.002	Pearson	710
LIE_Frequency	IPIP6_Extraversion	0.04	[-0.03, 0.11]	1.04	708	0.299	Pearson	710
LIE_Frequency	IPIP6_Agreableness	-0.11	[-0.18, -0.03]	-2.86	708	0.004	Pearson	710
LIE_Frequency	IPIP6_Conscientiousness	-0.11	[-0.18, -0.04]	-2.91	708	0.004	Pearson	710
LIE_Frequency	IPIP6_Neuroticism	0.06	[-0.02, 0.13]	1.56	708	0.119	Pearson	710
LIE_Frequency	IPIP6_Openeness	-0.09	[-0.16, -0.02]	-2.41	708	0.016	Pearson	710
LIE_Frequency	IPIP6_HonestyHumility	-0.14	[-0.21, -0.07]	-3.76	708	< .001	Pearson	710
LIE_Negativity	LIE_Contextuality	-0.30	[-0.36, -0.23]	-8.35	708	< .001	Pearson	710
LIE_Negativity	IPIP6_Extraversion	-0.07	[-0.15, 0.00]	-1.93	708	0.054	Pearson	710
LIE_Negativity	IPIP6_Agreableness	0.12	[ 0.05, 0.19]	3.24	708	0.001	Pearson	710
LIE_Negativity	IPIP6_Conscientiousness	0.07	[-0.01, 0.14]	1.75	708	0.080	Pearson	710
LIE_Negativity	IPIP6_Neuroticism	0.03	[-0.05, 0.10]	0.73	708	0.464	Pearson	710
LIE_Negativity	IPIP6_Openeness	-0.03	[-0.10, 0.05]	-0.74	708	0.458	Pearson	710
LIE_Negativity	IPIP6_HonestyHumility	-0.17	[-0.24, -0.10]	-4.59	708	< .001	Pearson	710
LIE_Contextuality	IPIP6_Extraversion	-0.09	[-0.17, -0.02]	-2.54	708	0.011	Pearson	710
LIE_Contextuality	IPIP6_Agreableness	0.03	[-0.04, 0.10]	0.81	708	0.416	Pearson	710
LIE_Contextuality	IPIP6_Conscientiousness	0.07	[ 0.00, 0.15]	1.93	708	0.054	Pearson	710
LIE_Contextuality	IPIP6_Neuroticism	-0.01	[-0.09, 0.06]	-0.37	708	0.712	Pearson	710
LIE_Contextuality	IPIP6_Openeness	-0.02	[-0.09, 0.05]	-0.53	708	0.599	Pearson	710
LIE_Contextuality	IPIP6_HonestyHumility	-0.07	[-0.14, 0.01]	-1.83	708	0.068	Pearson	710
IPIP6_Extraversion	IPIP6_Agreableness	0.30	[ 0.23, 0.37]	8.42	708	< .001	Pearson	710
IPIP6_Extraversion	IPIP6_Conscientiousness	-0.09	[-0.16, -0.01]	-2.32	708	0.021	Pearson	710
IPIP6_Extraversion	IPIP6_Neuroticism	-0.15	[-0.22, -0.08]	-4.14	708	< .001	Pearson	710
IPIP6_Extraversion	IPIP6_Openeness	0.10	[ 0.03, 0.17]	2.71	708	0.007	Pearson	710
IPIP6_Extraversion	IPIP6_HonestyHumility	-0.30	[-0.36, -0.23]	-8.33	708	< .001	Pearson	710
IPIP6_Agreableness	IPIP6_Conscientiousness	0.08	[ 0.01, 0.16]	2.24	708	0.025	Pearson	710
IPIP6_Agreableness	IPIP6_Neuroticism	0.10	[ 0.03, 0.18]	2.78	708	0.006	Pearson	710
IPIP6_Agreableness	IPIP6_Openeness	0.21	[ 0.14, 0.28]	5.67	708	< .001	Pearson	710
IPIP6_Agreableness	IPIP6_HonestyHumility	0.19	[ 0.12, 0.26]	5.28	708	< .001	Pearson	710
IPIP6_Conscientiousness	IPIP6_Neuroticism	-0.15	[-0.22, -0.08]	-4.03	708	< .001	Pearson	710
IPIP6_Conscientiousness	IPIP6_Openeness	-0.07	[-0.14, 0.01]	-1.82	708	0.069	Pearson	710
IPIP6_Conscientiousness	IPIP6_HonestyHumility	0.01	[-0.07, 0.08]	0.23	708	0.821	Pearson	710
IPIP6_Neuroticism	IPIP6_Openeness	-0.01	[-0.08, 0.07]	-0.22	708	0.823	Pearson	710
IPIP6_Neuroticism	IPIP6_HonestyHumility	-0.18	[-0.25, -0.11]	-4.80	708	< .001	Pearson	710
IPIP6_Openeness	IPIP6_HonestyHumility	0.07	[-0.01, 0.14]	1.81	708	0.071	Pearson	710

graphdata_ipip <- cor_ipip %>%
  filter(p < .001) %>%
  tidygraph::as_tbl_graph() %>%
  as.list()

graphdata_ipip$nodes$Questionnaire <- ifelse(stringr::str_detect(graphdata_ipip$nodes$name, "LIE_"),
                               "LIE", "Normal Personality")
graphdata_ipip$nodes$name <- stringr::str_remove(graphdata_ipip$nodes$name, "LIE_|IPIP6_")
graphdata_ipip$nodes$name <- stringr::str_replace(graphdata_ipip$nodes$name, "yH", "y /\nH")

ggm_ipip <- create_ggm(graphdata_ipip, title = "Normal Personality", layout="graphopt", node_size=40)
ggm_ipip

Pathological Personality (PID5)

cor_pid <- correlation::correlation(
  dplyr::select(df, dplyr::starts_with("LIE"), dplyr::starts_with("PID5"), -PID5_Pathology),
  partial = TRUE, p_adjust = "none")

parameters::parameters_table(cor_pid)

Parameter1	Parameter2	r	95% CI	t	df	p	Method	n_Obs
LIE_Ability	LIE_Frequency	0.23	[ 0.16, 0.29]	6.17	708	< .001	Pearson	710
LIE_Ability	LIE_Negativity	-0.17	[-0.24, -0.10]	-4.59	708	< .001	Pearson	710
LIE_Ability	LIE_Contextuality	0.38	[ 0.31, 0.44]	10.85	708	< .001	Pearson	710
LIE_Ability	PID5_NegativeAffect	-0.05	[-0.13, 0.02]	-1.40	708	0.163	Pearson	710
LIE_Ability	PID5_Detachment	-0.06	[-0.13, 0.02]	-1.50	708	0.134	Pearson	710
LIE_Ability	PID5_Antagonism	0.18	[ 0.10, 0.25]	4.79	708	< .001	Pearson	710
LIE_Ability	PID5_Disinhibition	-0.05	[-0.13, 0.02]	-1.39	708	0.165	Pearson	710
LIE_Ability	PID5_Psychoticism	0.02	[-0.05, 0.10]	0.60	708	0.548	Pearson	710
LIE_Frequency	LIE_Negativity	-0.47	[-0.52, -0.41]	-14.06	708	< .001	Pearson	710
LIE_Frequency	LIE_Contextuality	-0.12	[-0.19, -0.05]	-3.21	708	0.001	Pearson	710
LIE_Frequency	PID5_NegativeAffect	0.01	[-0.06, 0.09]	0.32	708	0.752	Pearson	710
LIE_Frequency	PID5_Detachment	0.06	[-0.02, 0.13]	1.53	708	0.127	Pearson	710
LIE_Frequency	PID5_Antagonism	0.07	[ 0.00, 0.14]	1.92	708	0.055	Pearson	710
LIE_Frequency	PID5_Disinhibition	0.16	[ 0.08, 0.23]	4.22	708	< .001	Pearson	710
LIE_Frequency	PID5_Psychoticism	-0.01	[-0.09, 0.06]	-0.31	708	0.754	Pearson	710
LIE_Negativity	LIE_Contextuality	-0.29	[-0.36, -0.23]	-8.18	708	< .001	Pearson	710
LIE_Negativity	PID5_NegativeAffect	0.11	[ 0.04, 0.18]	2.93	708	0.003	Pearson	710
LIE_Negativity	PID5_Detachment	-0.02	[-0.09, 0.06]	-0.48	708	0.631	Pearson	710
LIE_Negativity	PID5_Antagonism	0.00	[-0.07, 0.07]	0.03	708	0.976	Pearson	710
LIE_Negativity	PID5_Disinhibition	-0.01	[-0.08, 0.07]	-0.18	708	0.859	Pearson	710
LIE_Negativity	PID5_Psychoticism	0.01	[-0.06, 0.08]	0.25	708	0.804	Pearson	710
LIE_Contextuality	PID5_NegativeAffect	0.07	[ 0.00, 0.14]	1.83	708	0.067	Pearson	710
LIE_Contextuality	PID5_Detachment	0.04	[-0.03, 0.12]	1.18	708	0.239	Pearson	710
LIE_Contextuality	PID5_Antagonism	-0.05	[-0.13, 0.02]	-1.39	708	0.166	Pearson	710
LIE_Contextuality	PID5_Disinhibition	-0.04	[-0.11, 0.03]	-1.07	708	0.285	Pearson	710
LIE_Contextuality	PID5_Psychoticism	0.02	[-0.05, 0.09]	0.51	708	0.612	Pearson	710
PID5_NegativeAffect	PID5_Detachment	0.18	[ 0.11, 0.25]	4.90	708	< .001	Pearson	710
PID5_NegativeAffect	PID5_Antagonism	0.14	[ 0.07, 0.22]	3.88	708	< .001	Pearson	710
PID5_NegativeAffect	PID5_Disinhibition	0.15	[ 0.08, 0.22]	4.04	708	< .001	Pearson	710
PID5_NegativeAffect	PID5_Psychoticism	0.25	[ 0.18, 0.32]	6.79	708	< .001	Pearson	710
PID5_Detachment	PID5_Antagonism	0.11	[ 0.04, 0.18]	2.91	708	0.004	Pearson	710
PID5_Detachment	PID5_Disinhibition	0.07	[-0.01, 0.14]	1.78	708	0.075	Pearson	710
PID5_Detachment	PID5_Psychoticism	0.28	[ 0.21, 0.34]	7.62	708	< .001	Pearson	710
PID5_Antagonism	PID5_Disinhibition	0.24	[ 0.17, 0.31]	6.49	708	< .001	Pearson	710
PID5_Antagonism	PID5_Psychoticism	0.12	[ 0.05, 0.20]	3.31	708	< .001	Pearson	710
PID5_Disinhibition	PID5_Psychoticism	0.34	[ 0.28, 0.41]	9.77	708	< .001	Pearson	710

graphdata_pid <- cor_pid %>%
  filter(p < .001) %>%
  tidygraph::as_tbl_graph() %>%
  as.list()

graphdata_pid$nodes$Questionnaire <- ifelse(stringr::str_detect(graphdata_pid$nodes$name, "LIE_"),
                               "LIE", "Pathological Personality")
graphdata_pid$nodes$name <- stringr::str_remove(graphdata_pid$nodes$name, "LIE_|PID5_")
graphdata_pid$nodes$name <- stringr::str_replace(graphdata_pid$nodes$name, "eA", "e\nA")

ggm_pid <- create_ggm(graphdata_pid, title = "Pathological Personality", layout="graphopt", node_size=40)
ggm_pid

Light Triad (LTS)

cor_lts <- correlation::correlation(
  dplyr::select(df, dplyr::starts_with("LIE"), dplyr::starts_with("LTS"), -LTS_General),
  partial = TRUE, p_adjust = "none")

parameters::parameters_table(cor_lts)

Parameter1	Parameter2	r	95% CI	t	df	p	Method	n_Obs
LIE_Ability	LIE_Frequency	0.25	[ 0.18, 0.32]	7.01	708	< .001	Pearson	710
LIE_Ability	LIE_Negativity	-0.18	[-0.25, -0.11]	-4.88	708	< .001	Pearson	710
LIE_Ability	LIE_Contextuality	0.36	[ 0.30, 0.43]	10.37	708	< .001	Pearson	710
LIE_Ability	LTS_FaithInHumanity	0.06	[-0.01, 0.14]	1.66	708	0.097	Pearson	710
LIE_Ability	LTS_Humanism	-0.07	[-0.14, 0.01]	-1.80	708	0.072	Pearson	710
LIE_Ability	LTS_Kantianism	-0.02	[-0.10, 0.05]	-0.63	708	0.531	Pearson	710
LIE_Frequency	LIE_Negativity	-0.44	[-0.50, -0.38]	-13.02	708	< .001	Pearson	710
LIE_Frequency	LIE_Contextuality	-0.11	[-0.19, -0.04]	-3.07	708	0.002	Pearson	710
LIE_Frequency	LTS_FaithInHumanity	-0.13	[-0.21, -0.06]	-3.59	708	< .001	Pearson	710
LIE_Frequency	LTS_Humanism	0.06	[-0.02, 0.13]	1.53	708	0.127	Pearson	710
LIE_Frequency	LTS_Kantianism	0.12	[ 0.04, 0.19]	3.15	708	0.002	Pearson	710
LIE_Negativity	LIE_Contextuality	-0.31	[-0.37, -0.24]	-8.61	708	< .001	Pearson	710
LIE_Negativity	LTS_FaithInHumanity	-0.04	[-0.11, 0.04]	-1.00	708	0.316	Pearson	710
LIE_Negativity	LTS_Humanism	-0.05	[-0.13, 0.02]	-1.46	708	0.144	Pearson	710
LIE_Negativity	LTS_Kantianism	-0.14	[-0.21, -0.07]	-3.71	708	< .001	Pearson	710
LIE_Contextuality	LTS_FaithInHumanity	-0.02	[-0.10, 0.05]	-0.63	708	0.530	Pearson	710
LIE_Contextuality	LTS_Humanism	-0.08	[-0.15, -0.01]	-2.15	708	0.032	Pearson	710
LIE_Contextuality	LTS_Kantianism	-0.04	[-0.11, 0.03]	-1.10	708	0.271	Pearson	710
LTS_FaithInHumanity	LTS_Humanism	0.46	[ 0.40, 0.52]	13.88	708	< .001	Pearson	710
LTS_FaithInHumanity	LTS_Kantianism	0.15	[ 0.08, 0.22]	4.08	708	< .001	Pearson	710
LTS_Humanism	LTS_Kantianism	0.29	[ 0.23, 0.36]	8.19	708	< .001	Pearson	710

graphdata_lts <- cor_lts %>%
  filter(p < .001) %>%
  tidygraph::as_tbl_graph() %>%
  as.list()

graphdata_lts$nodes$Questionnaire <- ifelse(stringr::str_detect(graphdata_lts$nodes$name, "LIE_"),
                               "LIE", "Light Triad")
graphdata_lts$nodes$name <- stringr::str_remove(graphdata_lts$nodes$name, "LIE_|LTS_")
graphdata_lts$nodes$name <- stringr::str_replace(graphdata_lts$nodes$name, "InH", " in\nH")

ggm_lts <- create_ggm(graphdata_lts, title = "Light Triad", layout="fr", bend=0.15)
ggm_lts

Impulsivity (UPPS)

cor_upps <- correlation::correlation(
  dplyr::select(df, dplyr::starts_with("LIE"), dplyr::starts_with("UPPS"), -UPPS_General),
  partial = TRUE, p_adjust = "none")

parameters::parameters_table(cor_upps)

Parameter1	Parameter2	r	95% CI	t	df	p	Method	n_Obs
LIE_Ability	LIE_Frequency	0.24	[ 0.17, 0.31]	6.56	708	< .001	Pearson	710
LIE_Ability	LIE_Negativity	-0.19	[-0.26, -0.12]	-5.25	708	< .001	Pearson	710
LIE_Ability	LIE_Contextuality	0.35	[ 0.28, 0.41]	9.81	708	< .001	Pearson	710
LIE_Ability	UPPS_NegativeUrgency	0.02	[-0.05, 0.09]	0.56	708	0.578	Pearson	710
LIE_Ability	UPPS_PositiveUrgency	-0.01	[-0.09, 0.06]	-0.31	708	0.757	Pearson	710
LIE_Ability	UPPS_LackOfPerseverance	-0.07	[-0.14, 0.01]	-1.80	708	0.072	Pearson	710
LIE_Ability	UPPS_LackOfPremeditation	-0.03	[-0.10, 0.04]	-0.77	708	0.444	Pearson	710
LIE_Ability	UPPS_SensationSeeking	0.07	[-0.01, 0.14]	1.81	708	0.070	Pearson	710
LIE_Frequency	LIE_Negativity	-0.45	[-0.50, -0.39]	-13.30	708	< .001	Pearson	710
LIE_Frequency	LIE_Contextuality	-0.10	[-0.17, -0.02]	-2.61	708	0.009	Pearson	710
LIE_Frequency	UPPS_NegativeUrgency	0.04	[-0.04, 0.11]	1.03	708	0.304	Pearson	710
LIE_Frequency	UPPS_PositiveUrgency	0.18	[ 0.10, 0.25]	4.75	708	< .001	Pearson	710
LIE_Frequency	UPPS_LackOfPerseverance	0.04	[-0.03, 0.12]	1.15	708	0.252	Pearson	710
LIE_Frequency	UPPS_LackOfPremeditation	0.05	[-0.03, 0.12]	1.27	708	0.205	Pearson	710
LIE_Frequency	UPPS_SensationSeeking	0.03	[-0.04, 0.11]	0.90	708	0.368	Pearson	710
LIE_Negativity	LIE_Contextuality	-0.31	[-0.38, -0.25]	-8.77	708	< .001	Pearson	710
LIE_Negativity	UPPS_NegativeUrgency	0.09	[ 0.02, 0.16]	2.46	708	0.014	Pearson	710
LIE_Negativity	UPPS_PositiveUrgency	0.06	[-0.02, 0.13]	1.56	708	0.119	Pearson	710
LIE_Negativity	UPPS_LackOfPerseverance	-0.12	[-0.20, -0.05]	-3.33	708	< .001	Pearson	710
LIE_Negativity	UPPS_LackOfPremeditation	-0.13	[-0.20, -0.05]	-3.41	708	< .001	Pearson	710
LIE_Negativity	UPPS_SensationSeeking	0.03	[-0.05, 0.10]	0.68	708	0.497	Pearson	710
LIE_Contextuality	UPPS_NegativeUrgency	0.04	[-0.03, 0.11]	1.11	708	0.269	Pearson	710
LIE_Contextuality	UPPS_PositiveUrgency	-0.02	[-0.10, 0.05]	-0.62	708	0.535	Pearson	710
LIE_Contextuality	UPPS_LackOfPerseverance	-0.08	[-0.15, 0.00]	-2.08	708	0.038	Pearson	710
LIE_Contextuality	UPPS_LackOfPremeditation	-0.10	[-0.17, -0.02]	-2.54	708	0.011	Pearson	710
LIE_Contextuality	UPPS_SensationSeeking	0.06	[-0.01, 0.13]	1.64	708	0.102	Pearson	710
UPPS_NegativeUrgency	UPPS_PositiveUrgency	0.58	[ 0.52, 0.62]	18.74	708	< .001	Pearson	710
UPPS_NegativeUrgency	UPPS_LackOfPerseverance	-0.01	[-0.08, 0.06]	-0.27	708	0.787	Pearson	710
UPPS_NegativeUrgency	UPPS_LackOfPremeditation	0.02	[-0.05, 0.10]	0.64	708	0.521	Pearson	710
UPPS_NegativeUrgency	UPPS_SensationSeeking	-0.11	[-0.18, -0.04]	-2.98	708	0.003	Pearson	710
UPPS_PositiveUrgency	UPPS_LackOfPerseverance	0.03	[-0.04, 0.10]	0.82	708	0.415	Pearson	710
UPPS_PositiveUrgency	UPPS_LackOfPremeditation	0.23	[ 0.16, 0.30]	6.19	708	< .001	Pearson	710
UPPS_PositiveUrgency	UPPS_SensationSeeking	0.25	[ 0.18, 0.32]	6.84	708	< .001	Pearson	710
UPPS_LackOfPerseverance	UPPS_LackOfPremeditation	0.37	[ 0.30, 0.43]	10.44	708	< .001	Pearson	710
UPPS_LackOfPerseverance	UPPS_SensationSeeking	-0.14	[-0.21, -0.07]	-3.74	708	< .001	Pearson	710
UPPS_LackOfPremeditation	UPPS_SensationSeeking	8.08e-04	[-0.07, 0.07]	0.02	708	0.983	Pearson	710

graphdata_upps <- cor_upps %>%
  filter(p < .001) %>%
  tidygraph::as_tbl_graph() %>%
  as.list()

graphdata_upps$nodes$Questionnaire <- ifelse(stringr::str_detect(graphdata_upps$nodes$name, "LIE_"),
                               "LIE", "Impulsivity")
graphdata_upps$nodes$name <- stringr::str_remove(graphdata_upps$nodes$name, "LIE_|UPPS_")
graphdata_upps$nodes$name <- stringr::str_replace(graphdata_upps$nodes$name, "U", "\nU")
graphdata_upps$nodes$name <- stringr::str_replace(graphdata_upps$nodes$name, "OfP", " of\nP")
graphdata_upps$nodes$name <- stringr::str_replace(graphdata_upps$nodes$name, "nS", "n\nS")

ggm_upps <- create_ggm(graphdata_upps, title = "Impulsivity")
ggm_upps

Emotion Regulation (DERS)

cor_ders <- correlation::correlation(
  dplyr::select(df, dplyr::starts_with("LIE"), dplyr::starts_with("DERS"), -DERS_General),
  partial = TRUE, p_adjust = "none")

parameters::parameters_table(cor_ders)

Parameter1	Parameter2	r	95% CI	t	df	p	Method	n_Obs
LIE_Ability	LIE_Frequency	0.25	[ 0.18, 0.32]	6.87	708	< .001	Pearson	710
LIE_Ability	LIE_Negativity	-0.17	[-0.24, -0.10]	-4.67	708	< .001	Pearson	710
LIE_Ability	LIE_Contextuality	0.37	[ 0.31, 0.43]	10.61	708	< .001	Pearson	710
LIE_Ability	DERS_Awareness	-0.10	[-0.17, -0.03]	-2.70	708	0.007	Pearson	710
LIE_Ability	DERS_Clarity	-0.03	[-0.10, 0.05]	-0.75	708	0.453	Pearson	710
LIE_Ability	DERS_Goals	-0.06	[-0.13, 0.01]	-1.57	708	0.117	Pearson	710
LIE_Ability	DERS_Impulse	-0.01	[-0.08, 0.07]	-0.20	708	0.838	Pearson	710
LIE_Ability	DERS_NonAcceptance	0.01	[-0.06, 0.08]	0.28	708	0.783	Pearson	710
LIE_Ability	DERS_Strategies	0.03	[-0.04, 0.11]	0.88	708	0.379	Pearson	710
LIE_Frequency	LIE_Negativity	-0.49	[-0.54, -0.43]	-15.00	708	< .001	Pearson	710
LIE_Frequency	LIE_Contextuality	-0.12	[-0.19, -0.05]	-3.26	708	0.001	Pearson	710
LIE_Frequency	DERS_Awareness	0.07	[ 0.00, 0.14]	1.88	708	0.060	Pearson	710
LIE_Frequency	DERS_Clarity	0.09	[ 0.02, 0.17]	2.49	708	0.013	Pearson	710
LIE_Frequency	DERS_Goals	-0.06	[-0.14, 0.01]	-1.72	708	0.085	Pearson	710
LIE_Frequency	DERS_Impulse	0.15	[ 0.08, 0.22]	4.01	708	< .001	Pearson	710
LIE_Frequency	DERS_NonAcceptance	0.10	[ 0.02, 0.17]	2.60	708	0.010	Pearson	710
LIE_Frequency	DERS_Strategies	-0.02	[-0.09, 0.06]	-0.46	708	0.647	Pearson	710
LIE_Negativity	LIE_Contextuality	-0.29	[-0.36, -0.22]	-8.04	708	< .001	Pearson	710
LIE_Negativity	DERS_Awareness	-0.04	[-0.11, 0.04]	-0.95	708	0.342	Pearson	710
LIE_Negativity	DERS_Clarity	0.02	[-0.05, 0.10]	0.65	708	0.515	Pearson	710
LIE_Negativity	DERS_Goals	-0.04	[-0.11, 0.04]	-1.03	708	0.304	Pearson	710
LIE_Negativity	DERS_Impulse	0.05	[-0.02, 0.13]	1.46	708	0.146	Pearson	710
LIE_Negativity	DERS_NonAcceptance	0.15	[ 0.08, 0.22]	3.98	708	< .001	Pearson	710
LIE_Negativity	DERS_Strategies	0.00	[-0.08, 0.07]	-0.11	708	0.915	Pearson	710
LIE_Contextuality	DERS_Awareness	-0.02	[-0.09, 0.06]	-0.44	708	0.663	Pearson	710
LIE_Contextuality	DERS_Clarity	-6.81e-04	[-0.07, 0.07]	-0.02	708	0.986	Pearson	710
LIE_Contextuality	DERS_Goals	0.03	[-0.04, 0.11]	0.86	708	0.390	Pearson	710
LIE_Contextuality	DERS_Impulse	-0.02	[-0.09, 0.06]	-0.49	708	0.627	Pearson	710
LIE_Contextuality	DERS_NonAcceptance	0.02	[-0.06, 0.09]	0.48	708	0.630	Pearson	710
LIE_Contextuality	DERS_Strategies	0.01	[-0.06, 0.09]	0.35	708	0.729	Pearson	710
DERS_Awareness	DERS_Clarity	0.29	[ 0.22, 0.36]	8.12	708	< .001	Pearson	710
DERS_Awareness	DERS_Goals	-0.16	[-0.23, -0.08]	-4.22	708	< .001	Pearson	710
DERS_Awareness	DERS_Impulse	0.03	[-0.05, 0.10]	0.68	708	0.499	Pearson	710
DERS_Awareness	DERS_NonAcceptance	-0.09	[-0.16, -0.02]	-2.47	708	0.014	Pearson	710
DERS_Awareness	DERS_Strategies	-3.11e-04	[-0.07, 0.07]	-0.01	708	0.993	Pearson	710
DERS_Clarity	DERS_Goals	0.03	[-0.04, 0.10]	0.83	708	0.406	Pearson	710
DERS_Clarity	DERS_Impulse	0.09	[ 0.02, 0.16]	2.43	708	0.015	Pearson	710
DERS_Clarity	DERS_NonAcceptance	0.20	[ 0.13, 0.27]	5.38	708	< .001	Pearson	710
DERS_Clarity	DERS_Strategies	0.17	[ 0.10, 0.24]	4.61	708	< .001	Pearson	710
DERS_Goals	DERS_Impulse	0.27	[ 0.21, 0.34]	7.60	708	< .001	Pearson	710
DERS_Goals	DERS_NonAcceptance	0.14	[ 0.07, 0.21]	3.76	708	< .001	Pearson	710
DERS_Goals	DERS_Strategies	0.23	[ 0.16, 0.30]	6.42	708	< .001	Pearson	710
DERS_Impulse	DERS_NonAcceptance	0.04	[-0.03, 0.11]	1.10	708	0.271	Pearson	710
DERS_Impulse	DERS_Strategies	0.50	[ 0.44, 0.55]	15.17	708	< .001	Pearson	710
DERS_NonAcceptance	DERS_Strategies	0.24	[ 0.16, 0.30]	6.45	708	< .001	Pearson	710

graphdata_ders <- cor_ders %>%
  filter(p < .001) %>%
  tidygraph::as_tbl_graph() %>%
  as.list()

graphdata_ders$nodes$Questionnaire <- ifelse(stringr::str_detect(graphdata_ders$nodes$name, "LIE_"),
                               "LIE", "Emotion Regulation")
graphdata_ders$nodes$name <- stringr::str_remove(graphdata_ders$nodes$name, "LIE_|DERS_")
graphdata_ders$nodes$name <- stringr::str_replace(graphdata_ders$nodes$name, "nA", "n-\nA")

ggm_ders <- create_ggm(graphdata_ders, title = "Difficulties in Emotion Regulation")
ggm_ders

Interoception (MAIA2)

cor_maia <- correlation::correlation(
  dplyr::select(df, dplyr::starts_with("LIE"), dplyr::starts_with("MAIA2")),
  partial = TRUE, p_adjust = "none")

parameters::parameters_table(cor_maia)

Parameter1	Parameter2	r	95% CI	t	df	p	Method	n_Obs
LIE_Ability	LIE_Frequency	0.25	[ 0.18, 0.32]	6.79	708	< .001	Pearson	710
LIE_Ability	LIE_Negativity	-0.19	[-0.26, -0.11]	-5.05	708	< .001	Pearson	710
LIE_Ability	LIE_Contextuality	0.37	[ 0.31, 0.43]	10.69	708	< .001	Pearson	710
LIE_Ability	MAIA2_Noticing	0.10	[ 0.03, 0.17]	2.64	708	0.008	Pearson	710
LIE_Ability	MAIA2_BodyListening	0.00	[-0.08, 0.07]	-0.06	708	0.948	Pearson	710
LIE_Frequency	LIE_Negativity	-0.47	[-0.52, -0.41]	-14.07	708	< .001	Pearson	710
LIE_Frequency	LIE_Contextuality	-0.12	[-0.20, -0.05]	-3.35	708	< .001	Pearson	710
LIE_Frequency	MAIA2_Noticing	-0.07	[-0.14, 0.01]	-1.82	708	0.070	Pearson	710
LIE_Frequency	MAIA2_BodyListening	0.09	[ 0.01, 0.16]	2.31	708	0.021	Pearson	710
LIE_Negativity	LIE_Contextuality	-0.29	[-0.35, -0.22]	-7.98	708	< .001	Pearson	710
LIE_Negativity	MAIA2_Noticing	0.07	[ 0.00, 0.15]	1.97	708	0.049	Pearson	710
LIE_Negativity	MAIA2_BodyListening	0.01	[-0.07, 0.08]	0.21	708	0.833	Pearson	710
LIE_Contextuality	MAIA2_Noticing	-0.01	[-0.08, 0.06]	-0.29	708	0.773	Pearson	710
LIE_Contextuality	MAIA2_BodyListening	0.01	[-0.06, 0.08]	0.28	708	0.776	Pearson	710
MAIA2_Noticing	MAIA2_BodyListening	0.58	[ 0.53, 0.63]	19.12	708	< .001	Pearson	710

graphdata_maia <- cor_maia %>%
  filter(p < .001) %>%
  tidygraph::as_tbl_graph() %>%
  as.list()

graphdata_maia$nodes$Questionnaire <- ifelse(stringr::str_detect(graphdata_maia$nodes$name, "LIE_"),
                               "LIE", "Interoception")
graphdata_maia$nodes$name <- stringr::str_remove(graphdata_maia$nodes$name, "LIE_|MAIA2_")
graphdata_maia$nodes$name <- stringr::str_replace(graphdata_maia$nodes$name, "yL", "y\nL")

ggm_maia <- create_ggm(graphdata_maia, title = "Interoception")
ggm_maia

References

report::cite_packages(sessionInfo())

References
Ben-Shachar, Makowski & Lüdecke (2020). Compute and interpret indices of effect size. CRAN. Available from https://github.com/easystats/effectsize.
Daniel Lüdecke and Dominique Makowski (2020). easystats: Jump in the easyverse. R package version 0.2.0. https://github.com/easystats/easystats
Daniel Lüdecke, Dominique Makowski, Philip Waggoner and Mattan S. Ben-Shachar (2020). see: Visualisation Toolbox for ‘easystats’ and Extra Geoms, Themes and Color Palettes for ‘ggplot2’. R package version 0.5.1. https://CRAN.R-project.org/package=see
Dirk Eddelbuettel and Romain Francois (2011). Rcpp: Seamless R and C++ Integration. Journal of Statistical Software, 40(8), 1-18. URL http://www.jstatsoft.org/v40/i08/.
Goodrich B, Gabry J, Ali I & Brilleman S. (2018). rstanarm: Bayesian applied regression modeling via Stan. R package version 2.17.4. http://mc-stan.org/.
H. Wickham. ggplot2: Elegant Graphics for Data Analysis. Springer-Verlag New York, 2016.
Hadley Wickham (2019). forcats: Tools for Working with Categorical Variables (Factors). R package version 0.4.0. https://CRAN.R-project.org/package=forcats
Hadley Wickham (2019). stringr: Simple, Consistent Wrappers for Common String Operations. R package version 1.4.0. https://CRAN.R-project.org/package=stringr
Hadley Wickham and Lionel Henry (2019). tidyr: Tidy Messy Data. R package version 1.0.0. https://CRAN.R-project.org/package=tidyr
Hadley Wickham, Jim Hester and Romain Francois (2018). readr: Read Rectangular Text Data. R package version 1.3.1. https://CRAN.R-project.org/package=readr
Hadley Wickham, Romain François, Lionel Henry and Kirill Müller (2020). dplyr: A Grammar of Data Manipulation. R package version 0.8.5. https://CRAN.R-project.org/package=dplyr
Kirill Müller and Hadley Wickham (2019). tibble: Simple Data Frames. R package version 2.1.3. https://CRAN.R-project.org/package=tibble
Lionel Henry and Hadley Wickham (2019). purrr: Functional Programming Tools. R package version 0.3.3. https://CRAN.R-project.org/package=purrr
Lüdecke D, Waggoner P, Makowski D (2019). “insight: A Unified Interfaceto Access Information from Model Objects in R.” Journal of Open SourceSoftware, 4(38), 1412. doi: 10.21105/joss.01412 (URL:https://doi.org/10.21105/joss.01412).
Lüdecke, Ben-Shachar & Makowski (2020). Describe and understand your model’s parameters. CRAN. Available from https://easystats.github.io/parameters.
Lüdecke, Makowski, Waggoner & Patil (2020). Assessment of Regression Models Performance. CRAN. Available from https://easystats.github.io/performance
Makowski, D. & Lüdecke, D. (2019). The report package for R: Ensuring the use of best practices for results reporting. CRAN. Available from https://github.com/easystats/report. doi: .
Makowski, D., Ben-Shachar, M. S. & Lüdecke, D. (2020). Estimation of Model-Based Predictions, Contrasts and Means. CRAN.
Makowski, D., Ben-Shachar, M. S., Patil, I. & Lüdecke, D. (2020). Methods for Correlation Analysis. CRAN.
Makowski, D., Ben-Shachar, M., & Lüdecke, D. (2019). bayestestR: Describing Effects and their Uncertainty, Existence and Significance within the Bayesian Framework. Journal of Open Source Software, 4(40), 1541. doi:10.21105/joss.01541
Thomas Lin Pedersen (2019). ggforce: Accelerating ‘ggplot2’. R package version 0.3.1. https://CRAN.R-project.org/package=ggforce
Thomas Lin Pedersen (2020). ggraph: An Implementation of Grammar of Graphics for Graphs and Networks. R package version 2.0.3. https://CRAN.R-project.org/package=ggraph
Thomas Lin Pedersen (2020). tidygraph: A Tidy API for Graph Manipulation. R package version 1.2.0. https://CRAN.R-project.org/package=tidygraph
Wickham et al., (2019). Welcome to the tidyverse. Journal of Open Source Software, 4(43), 1686, https://doi.org/10.21105/joss.01686
Yihui Xie (2020). knitr: A General-Purpose Package for Dynamic Report Generation in R. R package version 1.28.